loncom/interface/lonspreadsheet.pm - diff

Return to lonspreadsheet.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/Attic/lonspreadsheet.pm between versions 1.56 and 1.100.4.2

version 1.56, 2001/07/21 22:45:46	version 1.100.4.2, 2002/09/27 20:41:25
Line 1	Line 1
	#
	# $Id$
	#
	# 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	# The LearningOnline Network with CAPA
# Spreadsheet/Grades Display Handler	# Spreadsheet/Grades Display Handler
#	#
Line 6	Line 31
# 01/01/01,02/01,03/01,19/01,20/01,22/01,	# 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/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,	# 03/19,03/20,03/21,03/27,04/05,04/09,
# 07/09,07/14,07/21 Gerd Kortemeyer	# 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;	package Apache::lonspreadsheet;

Line 18 use Apache::lonnet;	Line 71 use Apache::lonnet;
use Apache::Constants qw(:common :http);	use Apache::Constants qw(:common :http);
use GDBM_File;	use GDBM_File;
use HTML::TokeParser;	use HTML::TokeParser;
	use Apache::lonhtmlcommon;
#	#
# Caches for previously calculated spreadsheets	# Caches for previously calculated spreadsheets
#	#
Line 53 my %courseopt;	Line 106 my %courseopt;
my %useropt;	my %useropt;
my %parmhash;	my %parmhash;

	#
	# Some hashes for stats on timing and performance
	#

	my %starttimes;
	my %usedtimes;
	my %numbertimes;

# Stuff that only the screen handler can know	# Stuff that only the screen handler can know

my $includedir;	my $includedir;
Line 69 sub initsheet {	Line 130 sub initsheet {
$safeeval->permit("sort");	$safeeval->permit("sort");
$safeeval->deny(":base_io");	$safeeval->deny(":base_io");
$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');	$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
	$safeeval->share('$@');
my $code=<<'ENDDEFS';	my $code=<<'ENDDEFS';
# ---------------------------------------------------- Inside of the safe space	# ---------------------------------------------------- Inside of the safe space

Line 87 undef %c;	Line 149 undef %c;
undef %rl;	undef %rl;
undef @os;	undef @os;

undef $nfield;
undef $nsheet;

$maxrow=0;	$maxrow=0;
$sheettype='';	$sheettype='';

Line 115 $cfn='';	Line 174 $cfn='';

$usymb='';	$usymb='';

	# error messages

	$errormsg='';

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

Line 144 sub mask {	Line 207 sub mask {
} else {	} else {
if (length($ld)!=length($ud)) {	if (length($ld)!=length($ud)) {
$num.='(';	$num.='(';
map {	foreach ($ld=~m/\d/g) {
$num.='['.$_.'-9]';	$num.='['.$_.'-9]';
} ($ld=~m/\d/g);	}
if (length($ud)-length($ld)>1) {	if (length($ud)-length($ld)>1) {
$num.='\|\d{'.(length($ld)+1).','.(length($ud)-1).'}';	$num.='\|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
}	}
$num.='\|';	$num.='\|';
map {	foreach ($ud=~m/\d/g) {
$num.='[0-'.$_.']';	$num.='[0-'.$_.']';
} ($ud=~m/\d/g);	}
$num.=')';	$num.=')';
} else {	} else {
my @lda=($ld=~m/\d/g);	my @lda=($ld=~m/\d/g);
Line 191 sub mask {	Line 254 sub mask {
return '^'.$alpha.$num."\$";	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];
	}

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

	=item NUM(range)

	returns the number of items in the range.

	=cut

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

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


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

	=item SUM(range)

	returns the sum of items in the range.

	=cut

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

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

	=item MEAN(range)

	compute the average of the items in the range.

	=cut

	#-------------------------------------------------------
sub MEAN {	sub MEAN {
my $mask=mask(@_);	my $mask=mask(@_);
my $sum=0; my $num=0;	my $sum=0; my $num=0;
map {	foreach (grep /$mask/,keys(%v)) {
$sum+=$v{$_};	$sum+=$v{$_};
$num++;	$num++;
} grep /$mask/,keys %v;	}
if ($num) {	if ($num) {
return $sum/$num;	return $sum/$num;
} else {	} else {
Line 236 sub MEAN {	Line 590 sub MEAN {
}	}
}	}

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

	=item STDDEV(range)

	compute the standard deviation of the items in the range.

	=cut

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

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

	=item PROD(range)

	compute the product of the items in the range.

	=cut

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

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

	=item MAX(range)

	compute the maximum of the items in the range.

	=cut

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

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

	=item MIN(range)

	compute the minimum of the items in the range.

	=cut

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

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

	=item SUMMAX(num,lower,upper)

	compute the sum of the largest 'num' items in the range from
	'lower' to 'upper'

	=cut

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

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

	=item SUMMIN(num,lower,upper)

	compute the sum of the smallest 'num' items in the range from
	'lower' to 'upper'

	=cut

	#-------------------------------------------------------
sub SUMMIN {	sub SUMMIN {
my ($num,$lower,$upper)=@_;	my ($num,$lower,$upper)=@_;
my $mask=mask($lower,$upper);	my $mask=mask($lower,$upper);
my @inside=();	my @inside=();
map {	foreach (grep /$mask/,keys(%v)) {
$inside[$#inside+1]=$v{$_};	$inside[$#inside+1]=$v{$_};
} grep /$mask/,keys %v;	}
@inside=sort(@inside);	@inside=sort(@inside);
my $sum=0; my $i;	my $sum=0; my $i;
for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {	for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
Line 311 sub SUMMIN {	Line 721 sub SUMMIN {
return $sum;	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 {
	# it is not a function, so it is a parameter name
	# We should do the following:
	# 1. Take the list of parameter names
	# 2. look through the list for ones that match the parameter we want
	# 3. If there are no collisions, return the one that matches
	# 4. If there is a collision, return 'bad parameter name error'
	my $returnvalue = '';
	my @matches = ();
	$#matches = -1;
	study $expression;
	foreach $parameter (keys(%c)) {
	push @matches,$parameter if ($parameter =~ /$expression/);
	}
	if ($#matches == 0) {
	$returnvalue = '$c{\''.$matches[0].'\'}';
	} elsif ($#matches > 0) {
	# more than one match. Look for a concise one
	$returnvalue = "'non-unique parameter name : $expression'";
	foreach (@matches) {
	if (/^$expression$/) {
	$returnvalue = '$c{\''.$_.'\'}';
	}
	}
	} else {
	$returnvalue = "'bad parameter name : $expression'";
	}
	return $returnvalue;
	}
	}

sub sett {	sub sett {
%t=();	%t=();
my $pattern='';	my $pattern='';
Line 319 sub sett {	Line 791 sub sett {
} else {	} else {
$pattern='[A-Z]';	$pattern='[A-Z]';
}	}
map {
	# Deal with the template row
	foreach (keys(%f)) {
if ($_=~/template\_(\w)/) {	if ($_=~/template\_(\w)/) {
my $col=$1;	my $col=$1;
unless ($col=~/^$pattern/) {	unless ($col=~/^$pattern/) {
map {	foreach (keys(%f)) {
if ($_=~/A(\d+)/) {	if ($_=~/A(\d+)/) {
my $trow=$1;	my $trow=$1;
if ($trow) {	if ($trow) {
	# Get the name of this cell
my $lb=$col.$trow;	my $lb=$col.$trow;
	# Grab the template declaration
$t{$lb}=$f{'template_'.$col};	$t{$lb}=$f{'template_'.$col};
	# Replace '#' with the row number
$t{$lb}=~s/\#/$trow/g;	$t{$lb}=~s/\#/$trow/g;
	# Replace '....' with ','
$t{$lb}=~s/\.\.+/\,/g;	$t{$lb}=~s/\.\.+/\,/g;
	# Replace 'A0' with the value from 'A0'
$t{$lb}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;	$t{$lb}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
$t{$lb}=~s/(^\|[^\"\'])\[(\w+)\]/$1\$c\{\'$2\'\}/g;	# Replace parameters
	$t{$lb}=~s/(^\|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
}	}
}	}
} keys %f;	}
}	}
}	}
} keys %f;	}
map {
if (($f{$_}) && ($_!~/template\_/)) {	# Deal with the normal cells
	foreach (keys(%f)) {
	if (exists($f{$_}) && ($_!~/template\_/)) {
my $matches=($_=~/^$pattern(\d+)/);	my $matches=($_=~/^$pattern(\d+)/);
if (($matches) && ($1)) {	if (($matches) && ($1)) {
unless ($f{$_}=~/^\!/) {	unless ($f{$_}=~/^\!/) {
Line 350 sub sett {	Line 832 sub sett {
$t{$_}=$f{$_};	$t{$_}=$f{$_};
$t{$_}=~s/\.\.+/\,/g;	$t{$_}=~s/\.\.+/\,/g;
$t{$_}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;	$t{$_}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
$t{$_}=~s/(^\|[^\"\'])\[([\w\.]+)\]/$1\$c\{\'$2\'\}/g;	$t{$_}=~s/(^\|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
}	}
}	}
} keys %f;	}
	# For inserted lines, [B-Z] is also valid

	unless ($sheettype eq 'assesscalc') {
	foreach (keys(%f)) {
	if ($_=~/[B-Z](\d+)/) {
	if ($f{'A'.$1}=~/^[\~\-]/) {
	$t{$_}=$f{$_};
	$t{$_}=~s/\.\.+/\,/g;
	$t{$_}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
	$t{$_}=~s/(^\|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
	}
	}
	}
	}

	# For some reason 'A0' gets special treatment... This seems superfluous
	# but I imagine it is here for a reason.
$t{'A0'}=$f{'A0'};	$t{'A0'}=$f{'A0'};
$t{'A0'}=~s/\.\.+/\,/g;	$t{'A0'}=~s/\.\.+/\,/g;
$t{'A0'}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;	$t{'A0'}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
$t{'A0'}=~s/(^\|[^\"\'])\[([\w\.]+)\]/$1\$c\{\'$2\'\}/g;	$t{'A0'}=~s/(^\|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
}	}

sub calc {	sub calc {
%v=();	undef %v;
&sett();	&sett();
my $notfinished=1;	my $notfinished=1;
	my $lastcalc='';
my $depth=0;	my $depth=0;
while ($notfinished) {	while ($notfinished) {
$notfinished=0;	$notfinished=0;
map {	foreach (keys(%t)) {
my $old=$v{$_};	my $old=$v{$_};
$v{$_}=eval($t{$_});	$v{$_}=eval $t{$_};
if ($@) {	if ($@) {
%v=();	undef %v;
return $@;	return $_.': '.$@;
}	}
if ($v{$_} ne $old) { $notfinished=1; }	if ($v{$_} ne $old) { $notfinished=1; $lastcalc=$_; }
} keys %t;	}
$depth++;	$depth++;
if ($depth>100) {	if ($depth>100) {
%v=();	undef %v;
return 'Maximum calculation depth exceeded';	return $lastcalc.': Maximum calculation depth exceeded';
}	}
}	}
return '';	return '';
Line 388 sub calc {	Line 888 sub calc {
sub templaterow {	sub templaterow {
my @cols=();	my @cols=();
$cols[0]='<b><font size=+1>Template</font></b>';	$cols[0]='<b><font size=+1>Template</font></b>';
map {	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_'.$_};	my $fm=$f{'template_'.$_};
$fm=~s/[\'\"]/\&\#34;/g;	$fm=~s/[\'\"]/\&\#34;/g;
$cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm;	$cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm;
} ('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');
return @cols;	return @cols;
}	}

Line 404 sub outrowassess {	Line 904 sub outrowassess {
my @cols=();	my @cols=();
if ($n) {	if ($n) {
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});	my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});
$cols[0]=$rl{$f{'A'.$n}}.'<br>'.	if ($rl{$usy}) {
	$cols[0]=$rl{$usy}.'<br>'.
'<select name="sel_'.$n.'" onChange="changesheet('.$n.	'<select name="sel_'.$n.'" onChange="changesheet('.$n.
')"><option name="default">Default</option>';	')"><option name="default">Default</option>';
map {	} else { $cols[0]=''; }
	foreach (@os) {
$cols[0].='<option name="'.$_.'"';	$cols[0].='<option name="'.$_.'"';
if ($ufn eq $_) {	if ($ufn eq $_) {
$cols[0].=' selected';	$cols[0].=' selected';
}	}
$cols[0].='>'.$_.'</option>';	$cols[0].='>'.$_.'</option>';
} @os;	}
$cols[0].='</select>';	$cols[0].='</select>';
} else {	} else {
$cols[0]='<b><font size=+1>Export</font></b>';	$cols[0]='<b><font size=+1>Export</font></b>';
}	}
map {	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};	my $fm=$f{$_.$n};
$fm=~s/[\'\"]/\&\#34;/g;	$fm=~s/[\'\"]/\&\#34;/g;
$cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};	push(@cols,"'$_$n','$fm'".'___eq___'.$v{$_.$n});
} ('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');
return @cols;	return @cols;
}	}

Line 437 sub outrow {	Line 939 sub outrow {
} else {	} else {
$cols[0]='<b><font size=+1>Export</font></b>';	$cols[0]='<b><font size=+1>Export</font></b>';
}	}
map {	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};	my $fm=$f{$_.$n};
$fm=~s/[\'\"]/\&\#34;/g;	$fm=~s/[\'\"]/\&\#34;/g;
$cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};	$cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
} ('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');
return @cols;	return @cols;
}	}

sub exportrowa {	sub exportrowa {
my @exportarray=();	my @exportarray=();
map {	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'};	$exportarray[$#exportarray+1]=$v{$_.'0'};
} ('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');
return @exportarray;	return @exportarray;
}	}

Line 495 sub setrowlabels {	Line 997 sub setrowlabels {

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

# ------------------------------------------------------------------ Get values	# ------------------------------------------------------------------ Get values
Line 512 sub getformulas {	Line 1014 sub getformulas {
return %{$safeeval->varglob('f')};	return %{$safeeval->varglob('f')};
}	}

	# ----------------------------------------------------- Get value of $f{'A'.$n}

	sub getfa {
	my ($safeeval,$n)=@_;
	return $safeeval->reval('$f{"A'.$n.'"}');
	}

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

sub gettype {	sub gettype {
Line 532 sub getmaxrow {	Line 1041 sub getmaxrow {
my $safeeval=shift;	my $safeeval=shift;
return $safeeval->reval('$maxrow');	return $safeeval->reval('$maxrow');
}	}
# -------------------------------------------- Store which sheet needs changing

sub changesheet {
my ($safeeval,$nfield,$nsheet)=@_;
$safeeval->reval('$nfield='.$nfield.'; $nsheet='.$nsheet.';');
}

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

Line 643 sub rown {	Line 1146 sub rown {
my ($safeeval,$n)=@_;	my ($safeeval,$n)=@_;
my $defaultbg;	my $defaultbg;
my $rowdata='';	my $rowdata='';
	my $dataflag=0;
unless ($n eq '-') {	unless ($n eq '-') {
$defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';	$defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
} else {	} else {
$defaultbg='#E0FF';	$defaultbg='#E0FF';
}	}
if ((($n-1)/25)==int(($n-1)/25)) {	unless ($ENV{'form.showcsv'}) {
my $what='Student';	$rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>";
if (&gettype($safeeval) eq 'assesscalc') {	} else {
$what='Item';	$rowdata.="\n".'"'.$n.'"';
} elsif (&gettype($safeeval) eq 'studentcalc') {
$what='Assessment';
}
$rowdata.="</table>\n<br><table border=2>".
'<tr><td> <td>'.$what.'</td>';
map {
$rowdata.='<td>'.$_.'</td>';
} ('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');
$rowdata.='</tr>';
}	}
$rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>";
my $showf=0;	my $showf=0;
my $proc;	my $proc;
my $maxred;	my $maxred=1;
if (&gettype($safeeval) eq 'studentcalc') {	my $sheettype=&gettype($safeeval);
	if ($sheettype eq 'studentcalc') {
$proc='&outrowassess';	$proc='&outrowassess';
$maxred=26;	$maxred=26;
} else {	} else {
$proc='&outrow';	$proc='&outrow';
}	}
if (&gettype($safeeval) eq 'assesscalc') {	if ($sheettype eq 'assesscalc') {
$maxred=1;	$maxred=1;
} else {	} else {
$maxred=26;	$maxred=26;
}	}
if ($n eq '-') { $proc='&templaterow'; $n=-1; }	if (&getfa($safeeval,$n)=~/^[\~\-]/) { $maxred=1; }
map {	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 $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);	my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
	if ((($vl ne '') \|\| ($vl eq '0')) &&
	(($showf==1) \|\| ($sheettype ne 'studentcalc'))) { $dataflag=1; }
if ($showf==0) { $vl=$_; }	if ($showf==0) { $vl=$_; }
	unless ($ENV{'form.showcsv'}) {
if ($showf<=$maxred) { $bgcolor='#FFDDDD'; }	if ($showf<=$maxred) { $bgcolor='#FFDDDD'; }
if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }	if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }
if (($showf>$maxred) \|\| ((!$n) && ($showf>0))) {	if (($showf>$maxred) \|\| ((!$n) && ($showf>0))) {
if ($vl eq '') {	if ($vl eq '') {
$vl='<font size=+2 color='.$bgcolor.'>#</font>';	$vl='<font size=+2 color='.$bgcolor.'>#</font>';
}	}
$rowdata.=	$rowdata.='<td bgcolor='.$bgcolor.'>';
'<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.	if ($ENV{'request.role'} =~ /^st\./) {
'</a></td>';	$rowdata.=$vl;
	} else {
	$rowdata.='<a href="javascript:celledit('.$fm.');">'.
	$vl.'</a>';
	}
	$rowdata.='</td>';
} else {	} else {
$rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';	$rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';
}	}
	} else {
	$rowdata.=',"'.$vl.'"';
	}
$showf++;	$showf++;
} $safeeval->reval($proc.'('.$n.')');	} # End of foreach($safeval...)
return $rowdata.'</tr>';	if ($ENV{'form.showall'} \|\| ($dataflag)) {
	return $rowdata.($ENV{'form.showcsv'}?'':'</tr>');
	} else {
	return '';
	}
}	}

# ------------------------------------------------------------- Print out sheet	# ------------------------------------------------------------- Print out sheet
Line 719 sub outsheet {	Line 1227 sub outsheet {
$realm='Course';	$realm='Course';
}	}
my $maxyellow=52-$maxred;	my $maxyellow=52-$maxred;
my $tabledata=	my $tabledata;
	unless ($ENV{'form.showcsv'}) {
	$tabledata=
'<table border=2><tr><th colspan=2 rowspan=2><font size=+2>'.	'<table border=2><tr><th colspan=2 rowspan=2><font size=+2>'.
$realm.'</font></th>'.	$realm.'</font></th>'.
'<td bgcolor=#FFDDDD colspan='.$maxred.	'<td bgcolor=#FFDDDD colspan='.$maxred.
Line 727 sub outsheet {	Line 1237 sub outsheet {
'<td colspan='.$maxyellow.	'<td colspan='.$maxyellow.
'><b><font size=+1>Calculations</font></b></td></tr><tr>';	'><b><font size=+1>Calculations</font></b></td></tr><tr>';
my $showf=0;	my $showf=0;
map {	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++;	$showf++;
if ($showf<=$maxred) {	if ($showf<=$maxred) {
$tabledata.='<td bgcolor="#FFDDDD">';	$tabledata.='<td bgcolor="#FFDDDD">';
Line 735 sub outsheet {	Line 1248 sub outsheet {
$tabledata.='<td>';	$tabledata.='<td>';
}	}
$tabledata.="<b><font size=+1>$_</font></b></td>";	$tabledata.="<b><font size=+1>$_</font></b></td>";
} ('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',	$tabledata.='</tr>'.&rown($safeeval,'-').&rown($safeeval,0);
'a','b','c','d','e','f','g','h','i','j','k','l','m',	} else { $tabledata='<pre>'; }
'n','o','p','q','r','s','t','u','v','w','x','y','z');
$tabledata.='</tr>';	$r->print($tabledata);

my $row;	my $row;
my $maxrow=&getmaxrow($safeeval);	my $maxrow=&getmaxrow($safeeval);
$tabledata.=&rown($safeeval,'-');
$r->print($tabledata);	my @sortby=();
for ($row=0;$row<=$maxrow;$row++) {	my @sortidx=();
$r->print(&rown($safeeval,$row));	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> <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('</table>');	$r->print($ENV{'form.showcsv'}?'</pre>':'</table>');
}	}

#	#
# ----------------------------------------------- Read list of available sheets	# ----------------------------------------------- Read list of available sheets
#	#

sub othersheets {	sub othersheets {
my ($safeeval,$stype)=@_;	my ($safeeval,$stype)=@_;
	#
my $cnum=&getcnum($safeeval);	my $cnum=&getcnum($safeeval);
my $cdom=&getcdom($safeeval);	my $cdom=&getcdom($safeeval);
my $chome=&getchome($safeeval);	my $chome=&getchome($safeeval);
	#
my @alternatives=();	my @alternatives=();
my $result=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.	my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
$stype.'_spreadsheets',$chome);	my ($tmp) = keys(%results);
if ($result!~/^error\:/) {	unless ($tmp =~ /^(con_lost\|error\|no_such_host)/i) {
map {	@alternatives = sort (keys(%results));
$alternatives[$#alternatives+1]=	}
&Apache::lonnet::unescape((split(/\=/,$_))[0]);
} split(/\&/,$result);
}
return @alternatives;	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	# -------------------------------------- Read spreadsheet formulas for a course
#	#
Line 784 sub readsheet {	Line 1354 sub readsheet {
my $cdom=&getcdom($safeeval);	my $cdom=&getcdom($safeeval);
my $chome=&getchome($safeeval);	my $chome=&getchome($safeeval);

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

Line 813 sub readsheet {	Line 1388 sub readsheet {
my %f=();	my %f=();

if ($fn=~/^default\_/) {	if ($fn=~/^default\_/) {
my $sheetxml='';	my $sheetxml='';
{
my $fh;	my $fh;
if ($fh=Apache::File->new($includedir.	my $dfn=$fn;
'/default.'.&gettype($safeeval))) {	$dfn=~s/\_/\./g;
$sheetxml=join('',<$fh>);	if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
}	$sheetxml=join('',<$fh>);
}	} else {
my $parser=HTML::TokeParser->new(\$sheetxml);	$sheetxml='<field row="0" col="A">"Error"</field>';
my $token;	}
while ($token=$parser->get_token) {	%f=%{&parse_sheet(\$sheetxml)};
if ($token->[0] eq 'S') {	} elsif($fn=~/\/*\.spreadsheet$/) {
if ($token->[1] eq 'field') {	my $sheetxml=&Apache::lonnet::getfile
$f{$token->[2]->{'col'}.$token->[2]->{'row'}}=	(&Apache::lonnet::filelocation('',$fn));
$parser->get_text('/field');	if ($sheetxml == -1) {
}	$sheetxml='<field row="0" col="A">"Error loading spreadsheet '
if ($token->[1] eq 'template') {	.$fn.'"</field>';
$f{'template_'.$token->[2]->{'col'}}=	}
$parser->get_text('/template');	%f=%{&parse_sheet(\$sheetxml)};
	} 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{$_};
}	}
}	}
}	}
} else {
my $sheet='';
my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.$fn,
$chome);
unless ($reply=~/^error\:/) {
$sheet=$reply;
}
map {
my ($name,$value)=split(/\=/,$_);
$f{&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
} split(/\&/,$sheet);
}
# --------------------------------------------------------------- Cache and set	# --------------------------------------------------------------- Cache and set
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);	$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
&setformulas($safeeval,%f);	&setformulas($safeeval,%f);
Line 892 sub writesheet {	Line 1460 sub writesheet {
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);	$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
# ----------------------------------------------------------------- Write sheet	# ----------------------------------------------------------------- Write sheet
my $sheetdata='';	my $sheetdata='';
map {	foreach (keys(%f)) {
unless ($f{$_} eq 'import') {	unless ($f{$_} eq 'import') {
$sheetdata.=&Apache::lonnet::escape($_).'='.	$sheetdata.=&Apache::lonnet::escape($_).'='.
&Apache::lonnet::escape($f{$_}).'&';	&Apache::lonnet::escape($f{$_}).'&';
}	}
} keys %f;	}
$sheetdata=~s/\&$//;	$sheetdata=~s/\&$//;
my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'.	my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'.
$sheetdata,$chome);	$sheetdata,$chome);
Line 954 sub tmpread {	Line 1522 sub tmpread {
$fn=$tmpdir.$fn.'.tmp';	$fn=$tmpdir.$fn.'.tmp';
my $fh;	my $fh;
my %fo=();	my %fo=();
	my $countrows=0;
if ($fh=Apache::File->new($fn)) {	if ($fh=Apache::File->new($fn)) {
my $name;	my $name;
while ($name=<$fh>) {	while ($name=<$fh>) {
Line 961 sub tmpread {	Line 1530 sub tmpread {
my $value=<$fh>;	my $value=<$fh>;
chomp($value);	chomp($value);
$fo{$name}=$value;	$fo{$name}=$value;
	if ($name=~/^A(\d+)$/) {
	if ($1>$countrows) {
	$countrows=$1;
	}
	}
}	}
}	}
if ($nform eq 'changesheet') {	if ($nform eq 'changesheet') {
	$fo{'A'.$nfield}=(split(/\_\_\&\&\&\_\_/,$fo{'A'.$nfield}))[0];
unless ($ENV{'form.sel_'.$nfield} eq 'Default') {	unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
&changesheet($safeeval,$nfield,$ENV{'form.sel_'.$nfield});	$fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
	}
	} elsif ($nfield eq 'insertrow') {
	$countrows++;
	my $newrow=substr('000000'.$countrows,-7);
	if ($nform eq 'top') {
	$fo{'A'.$countrows}='--- '.$newrow;
	} else {
	$fo{'A'.$countrows}='~~~ '.$newrow;
}	}
} else {	} else {
if ($nfield) { $fo{$nfield}=$nform; }	if ($nfield) { $fo{$nfield}=$nform; }
Line 997 sub parmval {	Line 1580 sub parmval {
# ----------------------------------------------------- Cascading lookup scheme	# ----------------------------------------------------- Cascading lookup scheme
my $rwhat=$what;	my $rwhat=$what;
$what=~s/^parameter\_//;	$what=~s/^parameter\_//;
$what=~s/\_/\./;	$what=~s/\_([^\_]+)$/\.$1/;

my $symbparm=$symb.'.'.$what;	my $symbparm=$symb.'.'.$what;
my $mapparm=$mapname.'___(all).'.$what;	my $mapparm=$mapname.'___(all).'.$what;
Line 1077 sub updateclasssheet {	Line 1660 sub updateclasssheet {
my %currentlist=();	my %currentlist=();
my $now=time;	my $now=time;
unless ($classlst=~/^error\:/) {	unless ($classlst=~/^error\:/) {
map {	foreach (split(/\&/,$classlst)) {
my ($name,$value)=split(/\=/,$_);	my ($name,$value)=split(/\=/,$_);
my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));	my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));
my $active=1;	my $active=1;
if (($end) && ($now>$end)) { $active=0; }	if (($end) && ($now>$end)) { $active=0; }
	$active = 1 if ($ENV{'form.Status'} eq 'Any');
	$active = !$active if ($ENV{'form.Status'} eq 'Expired');
if ($active) {	if ($active) {
my $rowlabel='';	my $rowlabel='';
$name=&Apache::lonnet::unescape($name);	$name=&Apache::lonnet::unescape($name);
my ($sname,$sdom)=split(/\:/,$name);	my ($sname,$sdom)=split(/\:/,$name);
my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);	my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);
if ($ssec==-1) {	# if ($ssec==-1) {
$rowlabel='<font color=red>Data not available: '.$name.	# unless ($ENV{'form.showcsv'}) {
'</font>';	# $rowlabel='<font color=red>Data not available: '.$name.
} else {	# '</font>';
	# } else {
	# $rowlabel='ERROR","'.$name.
	# '","Data not available","","","';
	# }
	# } else {
my %reply=&Apache::lonnet::idrget($sdom,$sname);	my %reply=&Apache::lonnet::idrget($sdom,$sname);
my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.	my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.
':environment:firstname&middlename&lastname&generation',	':environment:firstname&middlename&lastname&generation',
&Apache::lonnet::homeserver($sname,$sdom));	&Apache::lonnet::homeserver($sname,$sdom));
	unless ($ENV{'form.showcsv'}) {
$rowlabel='<a href="/adm/studentcalc?uname='.$sname.	$rowlabel='<a href="/adm/studentcalc?uname='.$sname.
'&udom='.$sdom.'">'.	'&udom='.$sdom.'">'.
$ssec.' '.$reply{$sname}.'<br>';	$ssec.' '.$reply{$sname}.'<br>';
map {	foreach ( split(/\&/,$reply)) {
$rowlabel.=&Apache::lonnet::unescape($_).' ';	$rowlabel.=&Apache::lonnet::unescape($_).' ';
} split(/\&/,$reply);	}
$rowlabel.='</a>';	$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;	$currentlist{&Apache::lonnet::unescape($name)}=$rowlabel;
}	}
} split(/\&/,$classlst);	} # end of foreach (split(/\&/,$classlst))
#	#
# -------------------- Find discrepancies between the course row table and this	# -------------------- Find discrepancies between the course row table and this
#	#
Line 1116 sub updateclasssheet {	Line 1717 sub updateclasssheet {
my %existing=();	my %existing=();

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

# -------------------------------------------------------- New and unknown keys	# -------------------------------------------------------- New and unknown keys

map {	foreach (sort keys(%currentlist)) {
unless ($existing{$_}) {	unless ($existing{$_}) {
$changed=1;	$changed=1;
$maxrow++;	$maxrow++;
$f{'A'.$maxrow}=$_;	$f{'A'.$maxrow}=$_;
}	}
} sort keys %currentlist;	}

if ($changed) { &setformulas($safeeval,%f); }	if ($changed) { &setformulas($safeeval,%f); }

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

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

my $adduserstr='';	my $adduserstr='';
if ((&getuname($safeeval) ne $ENV{'user.name'}) \|\|	if ((&getuname($safeeval) ne $ENV{'user.name'}) \|\|
Line 1171 sub updatestudentassesssheet {	Line 1781 sub updatestudentassesssheet {
'&udom='.&getudom($safeeval);	'&udom='.&getudom($safeeval);
}	}

map {	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+)$/) {	if ($_=~/^src\_(\d+)\.(\d+)$/) {
my $mapid=$1;	my $mapid=$1;
my $resid=$2;	my $resid=$2;
Line 1186 sub updatestudentassesssheet {	Line 1810 sub updatestudentassesssheet {
'<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'.	'<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'.
$bighash{'title_'.$id}.'</a>';	$bighash{'title_'.$id}.'</a>';
if ($stype eq 'assesscalc') {	if ($stype eq 'assesscalc') {
map {	foreach (split(/\,/,
	&Apache::lonnet::metadata($srcf,'keys'))) {
if (($_=~/^stores\_(.)/) \|\| ($_=~/^parameter\_(.)/)) {	if (($_=~/^stores\_(.)/) \|\| ($_=~/^parameter\_(.)/)) {
my $key=$_;	my $key=$_;
my $display=	my $display=
Line 1198 sub updatestudentassesssheet {	Line 1823 sub updatestudentassesssheet {
$display.='<br>'.$key;	$display.='<br>'.$key;
$allkeys{$key}=$display;	$allkeys{$key}=$display;
}	}
} split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));	} # end of foreach
}	}
}	}
}	}
} keys %bighash;	} # end of foreach (keys(%bighash))
untie(%bighash);	untie(%bighash);

#	#
Line 1215 sub updatestudentassesssheet {	Line 1840 sub updatestudentassesssheet {
} elsif ($stype eq 'studentcalc') {	} elsif ($stype eq 'studentcalc') {
%current=%allassess;	%current=%allassess;
}	}
$updatedata{$ENV{'request.course.fn'}.'_'.$stype}=	$updatedata{$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}=
join('___;___',%current);	join('___;___',%current);
} else {	} else {
return 'Could not access course data';	return 'Could not access course data';
Line 1223 sub updatestudentassesssheet {	Line 1848 sub updatestudentassesssheet {
# ------------------------------------------------------ Get current from cache	# ------------------------------------------------------ Get current from cache
} else {	} else {
%current=split(/\_\_\_\;\_\_\_/,	%current=split(/\_\_\_\;\_\_\_/,
$updatedata{$ENV{'request.course.fn'}.'_'.$stype});	$updatedata{$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom});
}	}
# -------------------- Find discrepancies between the course row table and this	# -------------------- Find discrepancies between the course row table and this
#	#
Line 1234 sub updatestudentassesssheet {	Line 1859 sub updatestudentassesssheet {
my %existing=();	my %existing=();

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

# -------------------------------------------------------- New and unknown keys	# -------------------------------------------------------- New and unknown keys

map {	foreach (keys(%current)) {
unless ($existing{$_}) {	unless ($existing{$_}) {
$changed=1;	$changed=1;
$maxrow++;	$maxrow++;
$f{'A'.$maxrow}=$_;	$f{'A'.$maxrow}=$_;
}	}
} keys %current;	}

if ($changed) { &setformulas($safeeval,%f); }	if ($changed) { &setformulas($safeeval,%f); }

Line 1278 sub loadstudent {	Line 1908 sub loadstudent {
&getcid($safeeval),	&getcid($safeeval),
&getuhome($safeeval));	&getuhome($safeeval));
unless ($reply=~/^error\:/) {	unless ($reply=~/^error\:/) {
map {	foreach ( split(/\&/,$reply)) {
my ($name,$value)=split(/\=/,$_);	my ($name,$value)=split(/\=/,$_);
$cachedstores{&Apache::lonnet::unescape($name)}=	$cachedstores{&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);	&Apache::lonnet::unescape($value);
} split(/\&/,$reply);	}
}	}
}	}
my @assessdata=();	my @assessdata=();
map {	foreach (keys(%f)) {
if ($_=~/^A(\d+)/) {	if ($_=~/^A(\d+)/) {
my $row=$1;	my $row=$1;
unless (($f{$_}=~/^\!/) \|\| ($row==0)) {	unless (($f{$_}=~/^[\!\~\-]/) \|\| ($row==0)) {
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});	my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
@assessdata=&exportsheet(&getuname($safeeval),	@assessdata=&exportsheet(&getuname($safeeval),
&getudom($safeeval),	&getudom($safeeval),
'assesscalc',$usy,$ufn);	'assesscalc',$usy,$ufn);
my $index=0;	my $index=0;
map {	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]) {	if ($assessdata[$index]) {
my $col=$_;	my $col=$_;
if ($assessdata[$index]=~/\D/) {	if ($assessdata[$index]=~/\D/) {
Line 1308 sub loadstudent {	Line 1939 sub loadstudent {
}	}
}	}
$index++;	$index++;
} ('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');
}	}
}	}
} keys %f;	}
$cachedassess='';	$cachedassess='';
undef %cachedstores;	undef %cachedstores;
&setformulas($safeeval,%f);	&setformulas($safeeval,%f);
Line 1326 sub loadcourse {	Line 1956 sub loadcourse {
my %c=();	my %c=();
my %f=&getformulas($safeeval);	my %f=&getformulas($safeeval);
my $total=0;	my $total=0;
map {	foreach (keys(%f)) {
if ($_=~/^A(\d+)/) {	if ($_=~/^A(\d+)/) {
unless ($f{$_}=~/^\!/) { $total++; }	unless ($f{$_}=~/^[\!\~\-]/) { $total++; }
}	}
} keys %f;	}
my $now=0;	my $now=0;
my $since=time;	my $since=time;
$r->print(<<ENDPOP);	$r->print(<<ENDPOP);
Line 1345 sub loadcourse {	Line 1975 sub loadcourse {
</script>	</script>
ENDPOP	ENDPOP
$r->rflush();	$r->rflush();
map {	foreach (keys(%f)) {
if ($_=~/^A(\d+)/) {	if ($_=~/^A(\d+)/) {
my $row=$1;	my $row=$1;
unless (($f{$_}=~/^\!/) \|\| ($row==0)) {	unless (($f{$_}=~/^[\!\~\-]/) \|\| ($row==0)) {
my @studentdata=&exportsheet(split(/\:/,$f{$_}),	my @studentdata=&exportsheet(split(/\:/,$f{$_}),
'studentcalc');	'studentcalc');
undef %userrdatas;	undef %userrdatas;
Line 1359 ENDPOP	Line 1989 ENDPOP
$r->rflush();	$r->rflush();

my $index=0;	my $index=0;
map {	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]) {	if ($studentdata[$index]) {
my $col=$_;	my $col=$_;
if ($studentdata[$index]=~/\D/) {	if ($studentdata[$index]=~/\D/) {
Line 1372 ENDPOP	Line 2003 ENDPOP
}	}
}	}
$index++;	$index++;
} ('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');
}	}
}	}
} keys %f;	}
&setformulas($safeeval,%f);	&setformulas($safeeval,%f);
&setconstants($safeeval,%c);	&setconstants($safeeval,%c);
$r->print('<script>popwin.close()</script>');	$r->print('<script>popwin.close()</script>');
Line 1412 sub loadassessment {	Line 2042 sub loadassessment {
my $version=$cachedstores{'version:'.$symb};	my $version=$cachedstores{'version:'.$symb};
my $scope;	my $scope;
for ($scope=1;$scope<=$version;$scope++) {	for ($scope=1;$scope<=$version;$scope++) {
map {	foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) {
$returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};	$returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};
} split(/\:/,$cachedstores{$scope.':keys:'.$symb});	}
}	}

} else {	} else {
Line 1426 sub loadassessment {	Line 2056 sub loadassessment {
"restore:$udom:$uname:".	"restore:$udom:$uname:".
&Apache::lonnet::escape($namespace).":".	&Apache::lonnet::escape($namespace).":".
&Apache::lonnet::escape($symb),$uhome);	&Apache::lonnet::escape($symb),$uhome);
map {	foreach (split(/\&/,$answer)) {
my ($name,$value)=split(/\=/,$_);	my ($name,$value)=split(/\=/,$_);
$returnhash{&Apache::lonnet::unescape($name)}=	$returnhash{&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);	&Apache::lonnet::unescape($value);
} split(/\&/,$answer);	}
my $version;	my $version;
for ($version=1;$version<=$returnhash{'version'};$version++) {	for ($version=1;$version<=$returnhash{'version'};$version++) {
map {	foreach (split(/\:/,$returnhash{$version.':keys'})) {
$returnhash{$_}=$returnhash{$version.':'.$_};	$returnhash{$_}=$returnhash{$version.':'.$_};
} split(/\:/,$returnhash{$version.':keys'});	}
}	}
}	}
# ----------------------------- returnhash now has all stores for this resource	# ----------------------------- 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	# ---------------------------- initialize coursedata and userdata for this user
undef %courseopt;	undef %courseopt;
undef %useropt;	undef %useropt;
Line 1457 sub loadassessment {	Line 2099 sub loadassessment {
$courserdatas{$cid.'.last_cache'}=time;	$courserdatas{$cid.'.last_cache'}=time;
}	}
}	}
map {	foreach (split(/\&/,$courserdatas{$cid})) {
my ($name,$value)=split(/\=/,$_);	my ($name,$value)=split(/\=/,$_);
$courseopt{$userprefix.&Apache::lonnet::unescape($name)}=	$courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);	&Apache::lonnet::unescape($value);
} split(/\&/,$courserdatas{$cid});	}
# --------------------------------------------------- Get userdata (if present)	# --------------------------------------------------- Get userdata (if present)
unless	unless
((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {	((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
Line 1472 sub loadassessment {	Line 2114 sub loadassessment {
$userrdatas{$uname.'___'.$udom.'.last_cache'}=time;	$userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
}	}
}	}
map {	foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) {
my ($name,$value)=split(/\=/,$_);	my ($name,$value)=split(/\=/,$_);
$useropt{$userprefix.&Apache::lonnet::unescape($name)}=	$useropt{$userprefix.&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);	&Apache::lonnet::unescape($value);
} split(/\&/,$userrdatas{$uname.'___'.$udom});	}
}	}
# ----------------- now courseopt, useropt initialized for this user and course	# ----------------- now courseopt, useropt initialized for this user and course
# (used by parmval)	# (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=();	my %c=();

if (tie(%parmhash,'GDBM_File',	if (tie(%parmhash,'GDBM_File',
&getcfn($safeeval).'_parms.db',&GDBM_READER,0640)) {	&getcfn($safeeval).'_parms.db',&GDBM_READER(),0640)) {
my %f=&getformulas($safeeval);	my %f=&getformulas($safeeval);
map {	foreach (keys(%f)) {
if ($_=~/^A/) {	if ($_=~/^A/) {
unless ($f{$_}=~/^\!/) {	unless ($f{$_}=~/^[\!\~\-]/) {
if ($f{$_}=~/^parameter/) {	if ($f{$_}=~/^parameter/) {
	if ($thisassess{$f{$_}}) {
my $val=&parmval($f{$_},$safeeval);	my $val=&parmval($f{$_},$safeeval);
$c{$_}=$val;	$c{$_}=$val;
$c{$f{$_}}=$val;	$c{$f{$_}}=$val;
	}
} else {	} else {
my $key=$f{$_};	my $key=$f{$_};
my $ckey=$key;	my $ckey=$key;
$key=~s/^stores\_/resource\./;	$key=~s/^stores\_/resource\./;
$key=~s/\_/\./;	$key=~s/\_/\./g;
$c{$_}=$returnhash{$key};	$c{$_}=$returnhash{$key};
$c{$ckey}=$returnhash{$key};	$c{$ckey}=$returnhash{$key};
}	}
}	}
}	}
} keys %f;	}
untie(%parmhash);	untie(%parmhash);
}	}
&setconstants($safeeval,%c);	&setconstants($safeeval,%c);
Line 1525 sub hiddenfield {	Line 2181 sub hiddenfield {
sub selectbox {	sub selectbox {
my ($title,$name,$value,%options)=@_;	my ($title,$name,$value,%options)=@_;
my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';	my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
map {	foreach (sort keys(%options)) {
$selout.='<option value="'.$_.'"';	$selout.='<option value="'.$_.'"';
if ($_ eq $value) { $selout.=' selected'; }	if ($_ eq $value) { $selout.=' selected'; }
$selout.='>'.$options{$_}.'</option>';	$selout.='>'.$options{$_}.'</option>';
} sort keys %options;	}
return $selout.'</select>';	return $selout.'</select>';
}	}

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

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

#	#
# Check if cached	# Check if cached
#	#
Line 1612 sub exportsheet {	Line 2273 sub exportsheet {
my $found='';	my $found='';

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

unless ($found) {	unless ($found) {
&cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));	&cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));
if ($oldsheets{$key}) {	if ($oldsheets{$key}) {
map {	foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);	my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
if ($name eq $fn) {	if ($name eq $fn) {
$found=$value;	$found=$value;
}	}
} split(/\_\_\_\&\_\_\_/,$oldsheets{$key});	}
}	}
}	}
#	#
Line 1681 sub exportsheet {	Line 2342 sub exportsheet {
}	}
my %currentlystored=();	my %currentlystored=();
unless ($current=~/^error\:/) {	unless ($current=~/^error\:/) {
map {	foreach (split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current))) {
my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);	my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
$currentlystored{$name}=$value;	$currentlystored{$name}=$value;
} split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current));	}
}	}
$currentlystored{$fn}=join('___;___',@exportarr);	$currentlystored{$fn}=join('___;___',@exportarr);

my $newstore='';	my $newstore='';
map {	foreach (keys(%currentlystored)) {
if ($newstore) { $newstore.='___&___'; }	if ($newstore) { $newstore.='___&___'; }
$newstore.=$_.'___=___'.$currentlystored{$_};	$newstore.=$_.'___=___'.$currentlystored{$_};
} keys %currentlystored;	}
my $now=time;	my $now=time;
if ($stype eq 'studentcalc') {	if ($stype eq 'studentcalc') {
&Apache::lonnet::reply('put:'.	&Apache::lonnet::reply('put:'.
Line 1731 sub expirationdates {	Line 2392 sub expirationdates {
':nohist_expirationdates',	':nohist_expirationdates',
$ENV{'course.'.$cid.'.home'});	$ENV{'course.'.$cid.'.home'});
unless ($reply=~/^error\:/) {	unless ($reply=~/^error\:/) {
map {	foreach (split(/\&/,$reply)) {
my ($name,$value)=split(/\=/,$_);	my ($name,$value)=split(/\=/,$_);
$expiredates{&Apache::lonnet::unescape($name)}	$expiredates{&Apache::lonnet::unescape($name)}
=&Apache::lonnet::unescape($value);	=&Apache::lonnet::unescape($value);
} split(/\&/,$reply);	}
}	}
}	}

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

Line 1774 sub cachedssheets {	Line 2435 sub cachedssheets {
$ENV{'request.course.id'},	$ENV{'request.course.id'},
$shome);	$shome);
unless ($reply=~/^error\:/) {	unless ($reply=~/^error\:/) {
map {	foreach ( split(/\&/,$reply)) {
my ($name,$value)=split(/\=/,$_);	my ($name,$value)=split(/\=/,$_);
$oldsheets{&Apache::lonnet::unescape($name)}	$oldsheets{&Apache::lonnet::unescape($name)}
=&Apache::lonnet::unescape($value);	=&Apache::lonnet::unescape($value);
} split(/\&/,$reply);	}
}	}
$loadedcaches{$sname.'_'.$sdom}=1;	$loadedcaches{$sname.'_'.$sdom}=1;
}	}
Line 1805 sub handler {	Line 2466 sub handler {
return OK;	return OK;
}	}

	if ($ENV{'request.role'} =~ /^st\./) {
	delete $ENV{'form.unewfield'} if (exists($ENV{'form.unewfield'}));
	delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'}));
	}

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

$includedir=$r->dir_config('lonIncludes');	$includedir=$r->dir_config('lonIncludes');
Line 1816 $tmpdir=$r->dir_config('lonDaemons').'/t	Line 2482 $tmpdir=$r->dir_config('lonDaemons').'/t

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

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

# -------------------------------------- Interactive loading of specific sheet?	# -------------------------------------- Interactive loading of specific sheet?
if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {	if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {
Line 1855 $tmpdir=$r->dir_config('lonDaemons').'/t	Line 2516 $tmpdir=$r->dir_config('lonDaemons').'/t
# --------------------------------------------------------------- Screen output	# --------------------------------------------------------------- Screen output

$r->print('<html><head><title>LON-CAPA Spreadsheet</title>');	$r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
$r->print(<<ENDSCRIPT);	if ($ENV{'request.role'} !~ /^st\./) {
	$r->print(<<ENDSCRIPT);
<script language="JavaScript">	<script language="JavaScript">

function celledit(cn,cf) {	function celledit(cn,cf) {
var cnf=prompt(cn,cf);	var cnf=prompt(cn,cf);
if (cnf!=null) {	if (cnf!=null) {
document.sheet.unewfield.value=cn;	document.sheet.unewfield.value=cn;
document.sheet.unewformula.value=cnf;	document.sheet.unewformula.value=cnf;
document.sheet.submit();	document.sheet.submit();
}	}
Line 1873 $tmpdir=$r->dir_config('lonDaemons').'/t	Line 2535 $tmpdir=$r->dir_config('lonDaemons').'/t
document.sheet.submit();	document.sheet.submit();
}	}

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

</script>	</script>
ENDSCRIPT	ENDSCRIPT
	}
$r->print('</head><body bgcolor="#FFFFFF">'.	$r->print('</head><body bgcolor="#FFFFFF">'.
'<img align=right src=/adm/lonIcons/lonlogos.gif>'.	'<img align=right src=/adm/lonIcons/lonlogos.gif>'.
'<h1>LON-CAPA Spreadsheet</h1>'.	'<h1>LON-CAPA Spreadsheet</h1>'.
Line 1930 ENDSCRIPT	Line 2599 ENDSCRIPT
unless (&gettype($asheet) eq 'classcalc') {	unless (&gettype($asheet) eq 'classcalc') {
$r->print('<p><b>User:</b> '.&getuname($asheet).	$r->print('<p><b>User:</b> '.&getuname($asheet).
'<br><b>Domain:</b> '.&getudom($asheet));	'<br><b>Domain:</b> '.&getudom($asheet));
if (&getcsec($asheet) eq '-1') {	# if (&getcsec($asheet) eq '-1') {
$r->print('<h3><font color=red>'.	# $r->print('<h3><font color=red>'.
'Not a student in this course</font></h3>');	# 'Not a student in this course</font></h3>');
} else {	# } else {
$r->print('<br><b>Section/Group:</b> '.&getcsec($asheet));	$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	# ---------------------------------------------------------------- Course title

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

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

Line 1994 ENDSCRIPT	Line 2667 ENDSCRIPT
$r->print('<p><input type=submit name=load value="Load ...">'.	$r->print('<p><input type=submit name=load value="Load ...">'.
'<select name="loadthissheet">'.	'<select name="loadthissheet">'.
'<option name="default">Default</option>');	'<option name="default">Default</option>');
map {	foreach (&othersheets($asheet,&gettype($asheet))) {
$r->print('<option name="'.$_.'"');	$r->print('<option name="'.$_.'"');
if ($ENV{'form.ufn'} eq $_) {	if ($ENV{'form.ufn'} eq $_) {
$r->print(' selected');	$r->print(' selected');
}	}
$r->print('>'.$_.'</option>');	$r->print('>'.$_.'</option>');
} &othersheets($asheet,&gettype($asheet));	}
$r->print('</select><p>');	$r->print('</select><p>');
if (&gettype($asheet) eq 'studentcalc') {	if (&gettype($asheet) eq 'studentcalc') {
&setothersheets($asheet,&othersheets($asheet,'assesscalc'));	&setothersheets($asheet,&othersheets($asheet,'assesscalc'));
Line 2064 ENDSCRIPT	Line 2737 ENDSCRIPT

&tmpwrite($asheet);	&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('>');
	}

	# ------------------------------------------------------------------ Insertrows
	$r->print(' Student Status: '.
	&Apache::lonhtmlcommon::StatusOptions
	($ENV{'form.Status'},'sheet'));

	$r->print(<<ENDINSERTBUTTONS);
	<br>
	<input type='button' onClick='insertrow("top");'
	value='Insert Row Top'>
	<input type='button' onClick='insertrow("bottom");'
	value='Insert Row Bottom'><br>
	ENDINSERTBUTTONS

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

&outsheet($r,$asheet);	&outsheet($r,$asheet);
Line 2082 ENDSCRIPT	Line 2797 ENDSCRIPT

1;	1;
__END__	__END__

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

Removed from v.1.56
changed lines
	Added in v.1.100.4.2