loncom/interface/spreadsheet/Spreadsheet.pm - diff

Return to Spreadsheet.pm CVS log

Up to [LON-CAPA] / loncom / interface / spreadsheet

Diff for /loncom/interface/spreadsheet/Spreadsheet.pm between versions 1.30 and 1.71

version 1.30, 2003/11/17 19:55:41	version 1.71, 2006/09/03 00:45:51
Line 60 use HTML::TokeParser;	Line 60 use HTML::TokeParser;
use Spreadsheet::WriteExcel;	use Spreadsheet::WriteExcel;
use Time::HiRes;	use Time::HiRes;
use Apache::lonlocal;	use Apache::lonlocal;
	use lib '/home/httpd/lib/perl/';
	use LONCAPA;


##	##
## Package Variables	## Package Variables
Line 85 sub new {	Line 88 sub new {
my $class = ref($this) \|\| $this;	my $class = ref($this) \|\| $this;
my ($stype) = ($class =~ /Apache::(.*)$/);	my ($stype) = ($class =~ /Apache::(.*)$/);
#	#
my ($name,$domain,$filename,$usymb)=@_;	my ($name,$domain,$filename,$usymb,$section,$groups)=@_;
	if (defined($usymb) && ref($usymb)) {
	$usymb = $usymb->symb;
	}
	if (! defined($name) \|\| $name eq '') {
	$name = $env{'user.name'};
	}
	if (! defined($domain) \|\| $domain eq '') {
	$domain = $env{'user.domain'};
	}
	if (! defined($section) \|\| $section eq '') {
	$section = &Apache::lonnet::getsection($domain,$name,
	$env{'request.course.id'});
	}
	if (! defined($groups)) {

	my @usersgroups = &Apache::lonnet::get_users_groups($domain,$name,
	$env{'request.course.id'});
	$groups = \@usersgroups;
	}
#	#
my $self = {	my $self = {
name => $name,	name => $name,
domain => $domain,	domain => $domain,
	section => $section,
	groups => $groups,
type => $stype,	type => $stype,
symb => $usymb,	symb => $usymb,
errorlog => '',	errorlog => '',
maxrow => 0,	maxrow => 0,
cid => $ENV{'request.course.id'},	cid => $env{'request.course.id'},
cnum => $ENV{'course.'.$ENV{'request.course.id'}.'.num'},	cnum => $env{'course.'.$env{'request.course.id'}.'.num'},
cdom => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},	cdom => $env{'course.'.$env{'request.course.id'}.'.domain'},
chome => $ENV{'course.'.$ENV{'request.course.id'}.'.home'},	coursedesc => $env{'course.'.$env{'request.course.id'}.'.description'},
coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'},	coursefilename => $env{'request.course.fn'},
coursefilename => $ENV{'request.course.fn'},
#	#
# Flags	# Flags
temporary => 0, # true if this sheet has been modified but not saved	temporary => 0, # true if this sheet has been modified but not saved
new_rows => 0, # true if this sheet has new rows	new_rows => 0, # true if this sheet has new rows
	loaded => 0, # true if the formulas have been loaded
#	#
# blackout is used to determine if any data needs to be hidden from the	# blackout is used to determine if any data needs to be hidden from the
# student.	# student.
Line 117 sub new {	Line 141 sub new {
othersheets => [],	othersheets => [],
};	};
#	#
$self->{'uhome'} = &Apache::lonnet::homeserver($name,$domain);
#
bless($self,$class);	bless($self,$class);
#
# Load in the spreadsheet definition
$self->filename($filename);	$self->filename($filename);
if (exists($ENV{'form.workcopy'}) &&	#
$self->{'type'} eq $ENV{'form.workcopy'}) {
$self->load_tmp();
} else {
$self->load();
}
return $self;	return $self;
}	}

Line 151 sub filename {	Line 166 sub filename {
$newfilename !~ /\w/ \|\| $newfilename eq '') {	$newfilename !~ /\w/ \|\| $newfilename eq '') {
my $key = 'course.'.$self->{'cid'}.'.spreadsheet_default_'.	my $key = 'course.'.$self->{'cid'}.'.spreadsheet_default_'.
$self->{'type'};	$self->{'type'};
if (exists($ENV{$key}) && $ENV{$key} ne '') {	if (exists($env{$key}) && $env{$key} ne '') {
$newfilename = $ENV{$key};	$newfilename = $env{$key};
} else {	} else {
$newfilename = 'default_'.$self->{'type'};	$newfilename = 'default_'.$self->{'type'};
}	}
}	}
if ($newfilename !~ /\w/ \|\| $newfilename =~ /^\W*$/) {	if ($newfilename eq &mt('LON-CAPA Standard')) {
$newfilename = 'default_'.$self->{'type'};	undef($newfilename);
}	} else {
if ($newfilename !~ /^default\.$self->{'type'}$/ ) {	if ($newfilename !~ /\w/ \|\| $newfilename =~ /^\W*$/) {
if ($newfilename !~ /_$self->{'type'}$/) {	$newfilename = 'default_'.$self->{'type'};
$newfilename =~ s/[\s_]*$//;	}
$newfilename .= '_'.$self->{'type'};	if ($newfilename !~ /^default\.$self->{'type'}$/ &&
}	$newfilename !~ /^\/res\/(.*)spreadsheet$/) {
}	if ($newfilename !~ /_$self->{'type'}$/) {
	$newfilename =~ s/[\s_]*$//;
	$newfilename .= '_'.$self->{'type'};
	}
	}
	}
$self->{'filename'} = $newfilename;	$self->{'filename'} = $newfilename;
return;	return;
}	}
Line 190 sub make_default {	Line 210 sub make_default {
{'spreadsheet_default_'.$self->{'type'} => $self->filename()},	{'spreadsheet_default_'.$self->{'type'} => $self->filename()},
$self->{'cdom'},$self->{'cnum'});	$self->{'cdom'},$self->{'cnum'});
return $result if ($result ne 'ok');	return $result if ($result ne 'ok');
	&Apache::lonnet::appenv('course.'.$self->{'cid'}.'.spreadsheet_default_'.
	$self->{'type'} => $self->filename());
my $symb = $self->{'symb'};	my $symb = $self->{'symb'};
$symb = '' if (! defined($symb));	$symb = '' if (! defined($symb));
&Apache::lonnet::expirespread('','',$self->{'type'},$symb);	&Apache::lonnet::expirespread('','',$self->{'type'},$symb);
Line 210 course environment. Returns 0 otherwise	Line 232 course environment. Returns 0 otherwise
sub is_default {	sub is_default {
my $self = shift;	my $self = shift;
# Check to find out if we are the default spreadsheet (filenames match)	# Check to find out if we are the default spreadsheet (filenames match)
my $default_filename = '';	my $default_filename = $env{'course.'.$self->{'cid'}.
my %tmphash = &Apache::lonnet::get('environment',	'.spreadsheet_default_'.$self->{'type'}};
['spreadsheet_default_'.
$self->{'type'}],
$self->{'cdom'},
$self->{'cnum'});
my ($tmp) = keys(%tmphash);
if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {
$default_filename = $tmphash{'spreadsheet_default_'.$self->{'type'}};
}
if ($default_filename =~ /^\s*$/) {	if ($default_filename =~ /^\s*$/) {
$default_filename = 'default_'.$self->{'type'};	$default_filename = 'default_'.$self->{'type'};
}	}
Line 249 sub initialize_spreadsheet_package {	Line 263 sub initialize_spreadsheet_package {

sub load_spreadsheet_expirationdates {	sub load_spreadsheet_expirationdates {
undef %expiredates;	undef %expiredates;
my $cid=$ENV{'request.course.id'};	my $cid=$env{'request.course.id'};
my @tmp = &Apache::lonnet::dump('nohist_expirationdates',	my @tmp = &Apache::lonnet::dump('nohist_expirationdates',
$ENV{'course.'.$cid.'.domain'},	$env{'course.'.$cid.'.domain'},
$ENV{'course.'.$cid.'.num'});	$env{'course.'.$cid.'.num'});
if (lc($tmp[0]) !~ /^error/){	if (lc($tmp[0]) !~ /^error/){
%expiredates = @tmp;	%expiredates = @tmp;
}	}
Line 306 Returns the safe space required by a Spr	Line 320 Returns the safe space required by a Spr

sub initialize_safe_space {	sub initialize_safe_space {
my $self = shift;	my $self = shift;
	my $usection = &Apache::lonnet::getsection($self->{'domain'},
	$self->{'name'},
	$env{'request.course.id'});
if (! defined($safeeval)) {	if (! defined($safeeval)) {
$safeeval = new Safe(shift);	$safeeval = new Safe(shift);
my $safehole = new Safe::Hole;	my $safehole = new Safe::Hole;
Line 313 sub initialize_safe_space {	Line 330 sub initialize_safe_space {
$safeeval->permit(":base_math");	$safeeval->permit(":base_math");
$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,'&Apache::lonnet::EXT');
$safehole->wrap(\&mask,$safeeval,'&mask');	$safehole->wrap(\&mask,$safeeval,'&mask');
	$safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&logthis');
$safeeval->share('$@');	$safeeval->share('$@');
	# Holds the (computed, final) values for the sheet
	# This is only written to by &calc, the spreadsheet computation routine.
	# It is read by many functions
	$safeeval->share('%sheet_values');
my $code=<<'ENDDEFS';	my $code=<<'ENDDEFS';
# ---------------------------------------------------- Inside of the safe space	# ---------------------------------------------------- Inside of the safe space
#	#
Line 325 sub initialize_safe_space {	Line 347 sub initialize_safe_space {
# c: preloaded constants (A-column)	# c: preloaded constants (A-column)
# rl: row label	# rl: row label
# os: other spreadsheets (for student spreadsheet only)	# os: other spreadsheets (for student spreadsheet only)
undef %sheet_values; # Holds the (computed, final) values for the sheet	undef %t; # Holds the forumlas of the spreadsheet to be computed. Set in
# This is only written to by &calc, the spreadsheet computation routine.	# &sett, which does the translation of strings like C5 into the value
# It is read by many functions	# in C5. Used in &calc - %t holds the values that are actually eval'd.
undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett,
# which does the translation of strings like C5 into the value in C5.
# Used in &calc - %t holds the values that are actually eval'd.
undef %f; # Holds the formulas for each cell. This is the users	undef %f; # Holds the formulas for each cell. This is the users
# (spreadsheet authors) data for each cell.	# (spreadsheet authors) data for each cell.
undef %c; # Holds the constants for a sheet. In the assessment	undef %c; # Holds the constants for a sheet. In the assessment
Line 351 $filename = '';	Line 370 $filename = '';
#	#
# user data	# user data
$name = '';	$name = '';
$uhome = '';
$domain = '';	$domain = '';
#	#
# course data	# course data
$csec = '';	$csec = '';
$chome= '';
$cnum = '';	$cnum = '';
$cdom = '';	$cdom = '';
$cid = '';	$cid = '';
Line 372 $errormsg = '';	Line 389 $errormsg = '';

=pod	=pod

	=item EXT(parameter)

	Calls the system EXT function to determine the value of the given parameter.

	=cut

	#-------------------------------------------------------
	sub EXT {
	my ($parameter,$specific_symb) = @_;
	return '' if (! defined($parameter) \|\| $parameter eq '');
	$parameter =~ s/^parameter\./resource\./;
	if ($specific_symb eq '') { $specific_symb = $symb; }
	my $value = &Apache::lonnet::EXT($parameter,$specific_symb,$domain,$name,
	$usection);
	return $value;
	}

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

	=pod

=item NUM(range)	=item NUM(range)

returns the number of items in the range.	returns the number of items in the range.
Line 380 returns the number of items in the range	Line 418 returns the number of items in the range

#-------------------------------------------------------	#-------------------------------------------------------
sub NUM {	sub NUM {
my $mask=&mask(@_);	my $values=&get_values(@_);
my $num= $#{@{grep(eval("/$mask/"),keys(%sheet_values))}}+1;	my $num= scalar(@$values);
return $num;	return $num;
}	}

Line 396 sub NUM {	Line 434 sub NUM {
#-------------------------------------------------------	#-------------------------------------------------------
sub BIN {	sub BIN {
my ($low,$high,$lower,$upper)=@_;	my ($low,$high,$lower,$upper)=@_;
my $mask=&mask($lower,$upper);	my $values=&get_values($lower,$upper);
my $num=0;	my $num=0;
foreach (grep eval("/$mask/"),keys(%sheet_values)) {	foreach (@$values) {
if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {	if (($_>=$low) && ($_<=$high)) {
$num++;	$num++;
}	}
}	}
Line 418 returns the sum of items in the range.	Line 456 returns the sum of items in the range.

#-------------------------------------------------------	#-------------------------------------------------------
sub SUM {	sub SUM {
my $mask=&mask(@_);	my $values=&get_values(@_);
my $sum=0;	my $sum=0;
foreach (grep eval("/$mask/"),keys(%sheet_values)) {	foreach (@$values) {
$sum+=$sheet_values{$_};	$sum+=$_;
}	}
return $sum;	return $sum;
}	}
Line 438 compute the average of the items in the	Line 476 compute the average of the items in the

#-------------------------------------------------------	#-------------------------------------------------------
sub MEAN {	sub MEAN {
my $mask=&mask(@_);	my $values=&get_values(@_);
my $sum=0;	my $sum=0;
my $num=0;	my $num=0;
foreach (grep eval("/$mask/"),keys(%sheet_values)) {	foreach (@$values) {
$sum+=$sheet_values{$_};	$sum+=$_;
$num++;	$num++;
}	}
if ($num) {	if ($num) {
Line 464 compute the standard deviation of the it	Line 502 compute the standard deviation of the it

#-------------------------------------------------------	#-------------------------------------------------------
sub STDDEV {	sub STDDEV {
my $mask=&mask(@_);	my $values=&get_values(@_);
my $sum=0; my $num=0;	my $sum=0; my $num=0;
foreach (grep eval("/$mask/"),keys(%sheet_values)) {	foreach (@$values) {
$sum+=$sheet_values{$_};	$sum+=$_;
$num++;	$num++;
}	}
unless ($num>1) { return undef; }	unless ($num>1) { return undef; }
my $mean=$sum/$num;	my $mean=$sum/$num;
$sum=0;	$sum=0;
foreach (grep eval("/$mask/"),keys(%sheet_values)) {	foreach (@$values) {
$sum+=($sheet_values{$_}-$mean)**2;	$sum+=($_-$mean)**2;
}	}
return sqrt($sum/($num-1));	return sqrt($sum/($num-1));
}	}
Line 491 compute the product of the items in the	Line 529 compute the product of the items in the

#-------------------------------------------------------	#-------------------------------------------------------
sub PROD {	sub PROD {
my $mask=&mask(@_);	my $values=&get_values(@_);
my $prod=1;	my $prod=1;
foreach (grep eval("/$mask/"),keys(%sheet_values)) {	foreach (@$values) {
$prod*=$sheet_values{$_};	$prod*=$_;
}	}
return $prod;	return $prod;
}	}
Line 511 compute the maximum of the items in the	Line 549 compute the maximum of the items in the

#-------------------------------------------------------	#-------------------------------------------------------
sub MAX {	sub MAX {
my $mask=&mask(@_);	my $values=&get_values(@_);
my $max='-';	my $max='-';
foreach (grep eval("/$mask/"),keys(%sheet_values)) {	foreach (@$values) {
unless ($max) { $max=$sheet_values{$_}; }	if (($_>$max) \|\| ($max eq '-')) {
if (($sheet_values{$_}>$max) \|\| ($max eq '-')) {	$max=$_;
$max=$sheet_values{$_};
}	}
}	}
return $max;	return $max;
Line 534 compute the minimum of the items in the	Line 571 compute the minimum of the items in the

#-------------------------------------------------------	#-------------------------------------------------------
sub MIN {	sub MIN {
my $mask=&mask(@_);	my $values=&get_values(@_);
my $min='-';	my $min='-';
foreach (grep eval("/$mask/"),keys(%sheet_values)) {	foreach (@$values) {
unless ($max) { $max=$sheet_values{$_}; }	if (($_<$min) \|\| ($min eq '-')) {
if (($sheet_values{$_}<$min) \|\| ($min eq '-')) {	$min=$_;
$min=$sheet_values{$_};
}	}
}	}
return $min;	return $min;
Line 559 compute the sum of the largest 'num' ite	Line 595 compute the sum of the largest 'num' ite
#-------------------------------------------------------	#-------------------------------------------------------
sub SUMMAX {	sub SUMMAX {
my ($num,$lower,$upper)=@_;	my ($num,$lower,$upper)=@_;
my $mask=&mask($lower,$upper);	my $values=&get_values($lower,$upper);
my @inside=();	my @inside=sort {$a <=> $b} (@$values);
foreach (grep eval("/$mask/"),keys(%sheet_values)) {
push (@inside,$sheet_values{$_});
}
@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--) {
$sum+=$inside[$i];	$sum+=$inside[$i];
Line 586 compute the sum of the smallest 'num' it	Line 618 compute the sum of the smallest 'num' it
#-------------------------------------------------------	#-------------------------------------------------------
sub SUMMIN {	sub SUMMIN {
my ($num,$lower,$upper)=@_;	my ($num,$lower,$upper)=@_;
my $mask=&mask($lower,$upper);	my $values=&get_values($lower,$upper);
my @inside=();	my @inside=sort {$a <=> $b} (@$values);
foreach (grep eval("/$mask/"),keys(%sheet_values)) {
$inside[$#inside+1]=$sheet_values{$_};
}
@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++) {
$sum+=$inside[$i];	$sum+=$inside[$i];
Line 614 parametername should be a string such as	Line 642 parametername should be a string such as
sub MINPARM {	sub MINPARM {
my ($expression) = @_;	my ($expression) = @_;
my $min = undef;	my $min = undef;
study($expression);
foreach $parameter (keys(%c)) {	foreach $parameter (keys(%c)) {
next if ($parameter !~ /$expression/);	next if ($parameter !~ /$expression/);
if ((! defined($min)) \|\| ($min > $c{$parameter})) {	if ((! defined($min)) \|\| ($min > $c{$parameter})) {
Line 639 parametername should be a string such as	Line 666 parametername should be a string such as
sub MAXPARM {	sub MAXPARM {
my ($expression) = @_;	my ($expression) = @_;
my $max = undef;	my $max = undef;
study($expression);
foreach $parameter (keys(%c)) {	foreach $parameter (keys(%c)) {
next if ($parameter !~ /$expression/);	next if ($parameter !~ /$expression/);
if ((! defined($min)) \|\| ($max < $c{$parameter})) {	if ((! defined($min)) \|\| ($max < $c{$parameter})) {
Line 649 sub MAXPARM {	Line 675 sub MAXPARM {
return $max;	return $max;
}	}

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

	=pod

	=item &get_values($lower,$upper)

	Inputs: $lower and $upper, cell names ("X12" or "a150") or globs ("X*").

	Returns: an array ref of the values of the cells that exist in the
	speced range

	=cut

	#-------------------------------------------------------
	sub get_values {
	my ($lower,$upper)=@_;
	$upper = $lower if (! defined($upper));
	my @values;
	my ($la,$ld) = ($lower=~/([A-z]\|\)(\d+\|\)/);
	my ($ua,$ud) = ($upper=~/([A-z]\|\)(\d+\|\)/);
	my ($alpha,$num);
	if ($ld ne '' && $ud ne '') {
	my @alpha;
	if (($la eq '') \|\| ($ua eq '')) {
	@alpha=('A'..'z');
	} else {
	if ($la gt $ua) { ($la,$ua)=($ua,$la); }
	if ((lc($la) ne $la) && (lc($ua) eq $ua)) {
	@alpha=($la..'Z','a'..$ua);
	} else {
	@alpha=($la..$ua);
	}
	}
	my @num=($ld..$ud);
	foreach my $a (@alpha) {
	foreach my $n (@num) {
	if (exists($sheet_values{$a.$n})) {
	push(@values,$sheet_values{$a.$n});
	}
	}
	}
	return \@values;
	} else {
	$num = '([1-9]\d*)';
	}
	if (($la eq '') \|\| ($ua eq '')) {
	$alpha='[A-z]';
	} else {
	if ($la gt $ua) { ($la,$ua)=($ua,$la); }
	$alpha=qq/[$la-$ua]/;
	}
	my $expression = '^'.$alpha.$num.'$';
	foreach (grep /$expression/,keys(%sheet_values)) {
	push(@values,$sheet_values{$_});
	}
	return \@values;
	}

sub calc {	sub calc {
%sheet_values = %t;
my $notfinished = 1;	my $notfinished = 1;
my $lastcalc = '';	my $lastcalc = '';
my $depth = 0;	my $depth = 0;
Line 691 ENDDEFS	Line 773 ENDDEFS
# Place some of the %$self items into the safe space except the safe space	# Place some of the %$self items into the safe space except the safe space
# itself	# itself
my $initstring = '';	my $initstring = '';
foreach (qw/name domain type usymb cid csec coursefilename	foreach (qw/name domain type symb cid csec coursefilename
cnum cdom chome uhome/) {	cnum cdom/) {
$initstring.= qq{\$$_="$self->{$_}";};	$initstring.= qq{\$$_="$self->{$_}";};
}	}
	$initstring.=qq{\$usection="$usection";};
$self->{'safe'}->reval($initstring);	$self->{'safe'}->reval($initstring);
return $self;	return $self;
}	}
Line 711 ENDDEFS	Line 794 ENDDEFS

######################################################	######################################################


######################################################

=pod

=item &mask($lower,$upper)

Inputs: $lower and $upper, cell names ("X12" or "a150") or globs ("X*").

Returns: Regular expression matching spreadsheet cells that are within
the rectangle defined by $lower and $upper. Due to the nature of the
regular expression this result must be used inside an eval().

=cut

######################################################
{

my %memoizer;

sub mask {
my ($lower,$upper)=@_;
my $key = $lower.'_'.$upper;
if (exists($memoizer{$key})) {
return $memoizer{$key};
}
$upper = $lower if (! defined($upper));
#
my ($la,$ld) = ($lower=~/([A-z]\|\)(\d+\|\)/);
my ($ua,$ud) = ($upper=~/([A-z]\|\)(\d+\|\)/);
#
my $alpha='';
my $num='';
#
# Do not put parenthases around $alpha.
# $num depends on the value in $1.
if (($la eq '') \|\| ($ua eq '')) {
$alpha='[A-z]';
} else {
if ($la gt $ua) {
my $tmp = $ua;
$ua = $la;
$la = $ua;
}
$alpha=qq/[$la-$ua]/;
}
if ($ld ne '' && $ud ne '') {
# Make sure $ld <= $ud
if ($ld > $ud) {
my $tmp = $ud;
$ud = $ld;
$ld = $tmp;
}
# Here we make a regular expression using some advanced regexp
# abilities.
# (\d+) will match the digits of the cell name and dump them in
# to $1
# (?(?{ ... code ...} pattern_if_true \| pattern_if_false)) will
# choose pattern_if_true if { ... code ... } is true and
# pattern_if_false if { ... code ... } is false.
# In this case, pattern_if_true is empty. pattern_if_false is
# 'donotmatch' and will not match our cells because none of
# them end with donotmatch.
# Unfortunately, the use of this type of regular expression
# requires that each match be wrapped in an eval(). Search for
# $mask in this module for examples
$num = '(\d+)(?(?{$1>= '.$ld.' && $1<='.$ud.'})\|donotmatch)';
} else {
$num = '(\d+)';
}
my $expression = '^'.$alpha.$num.'$';
$memoizer{$key} = $expression;
return $expression;
}

#
# Debugging routine
sub dump_memoized_values {
while (my ($key,$value) = each(%memoizer)) {
&Apache::lonnet::logthis('memoizer: '.$key.' = '.$value);
}
return;
}

}

##	##
## sub add_hash_to_safe {} # spreadsheet, would like to destroy	## sub add_hash_to_safe {} # spreadsheet, would like to destroy
##	##
Line 830 sub expandnamed {	Line 827 sub expandnamed {
$result.=$thissum.'+';	$result.=$thissum.'+';
}	}
$result=~s/\+$//;	$result=~s/\+$//;
return $result;	return '('.$result.')';
} else {	} else {
return 0;	return 0;
}	}
Line 845 sub expandnamed {	Line 842 sub expandnamed {
my @matches = ();	my @matches = ();
my @values = ();	my @values = ();
$#matches = -1;	$#matches = -1;
study $expression;
while (my($parameter,$value) = each(%{$self->{'constants'}})) {	while (my($parameter,$value) = each(%{$self->{'constants'}})) {
next if ($parameter !~ /$expression/);	next if ($parameter !~ /$expression/);
push(@matches,$parameter);	push(@matches,$parameter);
Line 877 sub expandnamed {	Line 873 sub expandnamed {
sub sett {	sub sett {
my $self = shift;	my $self = shift;
my %t=();	my %t=();
	undef(%Apache::Spreadsheet::sheet_values);
#	#
# Deal with the template row	# Deal with the template row
foreach my $col ($self->template_cells()) {	foreach my $col ($self->template_cells()) {
Line 907 sub sett {	Line 904 sub sett {
$t{$cell}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;	$t{$cell}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
$t{$cell}=~s/(^\|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;	$t{$cell}=~s/(^\|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
} elsif ( $col =~ /^[A-Z]$/ ) {	} elsif ( $col =~ /^[A-Z]$/ ) {
if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell})) {	if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell})
my $data = $self->{'constants'}->{$cell};	&& $self->{'constants'}->{$cell} ne '') {
$t{$cell} = $data;	$Apache::Spreadsheet::sheet_values{$cell}=
	eval($self->{'constants'}->{$cell});
}	}
} else { # $row > 1 and $col =~ /[a-z]	} else { # $row > 1 and $col =~ /[a-z]
$t{$cell}=$formula;	$t{$cell}=$formula;
Line 928 sub sett {	Line 926 sub sett {
sub sync_safe_space {	sub sync_safe_space {
my $self = shift;	my $self = shift;
# Inside the safe space 'formulas' has a diabolical alter-ego named 'f'.	# Inside the safe space 'formulas' has a diabolical alter-ego named 'f'.
%{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}};	#%{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}};
# 'constants' leads a peaceful hidden life of 'c'.	# 'constants' leads a peaceful hidden life of 'c'.
%{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}};	%{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}};
# 'othersheets' hides as 'os', a disguise few can penetrate.	# 'othersheets' hides as 'os', a disguise few can penetrate.
@{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}};	#@{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}};
}	}

##	##
Line 985 sub formulas {	Line 983 sub formulas {
$self->{'formulas'} = $formulas;	$self->{'formulas'} = $formulas;
$self->{'rows'} = [];	$self->{'rows'} = [];
$self->{'template_cells'} = [];	$self->{'template_cells'} = [];
	$self->{'loaded'} = 1;
return;	return;
} else {	} else {
	$self->check_formulas_loaded();
return %{$self->{'formulas'}};	return %{$self->{'formulas'}};
}	}
}	}

	sub check_formulas_loaded {
	my $self=shift;
	if (!$self->{'loaded'}) {
	$self->{'loaded'}=1;
	# Load in the spreadsheet definition
	if (exists($env{'form.workcopy'}) &&
	$self->{'type'} eq $env{'form.workcopy'}) {
	$self->load_tmp();
	} else {
	$self->load();
	}
	}
	}

sub set_formula {	sub set_formula {
my $self = shift;	my $self = shift;
my ($cell,$formula) = @_;	my ($cell,$formula) = @_;
	$self->check_formulas_loaded();
$self->{'formulas'}->{$cell}=$formula;	$self->{'formulas'}->{$cell}=$formula;
return;	return;
}	}
Line 1003 sub set_formula {	Line 1018 sub set_formula {
##	##
sub formulas_keys {	sub formulas_keys {
my $self = shift;	my $self = shift;
my @keys = keys(%{$self->{'formulas'}});	$self->check_formulas_loaded();
return keys(%{$self->{'formulas'}});	return keys(%{$self->{'formulas'}});
}	}

Line 1014 sub formulas_keys {	Line 1029 sub formulas_keys {
sub formula {	sub formula {
my $self = shift;	my $self = shift;
my $cell = shift;	my $cell = shift;
	$self->check_formulas_loaded();
if (defined($cell) && exists($self->{'formulas'}->{$cell})) {	if (defined($cell) && exists($self->{'formulas'}->{$cell})) {
return $self->{'formulas'}->{$cell};	return $self->{'formulas'}->{$cell};
}	}
Line 1092 sub rebuild_stats {	Line 1108 sub rebuild_stats {
my $self = shift;	my $self = shift;
$self->{'rows'}=[];	$self->{'rows'}=[];
$self->{'template_cells'}=[];	$self->{'template_cells'}=[];
	$self->check_formulas_loaded();
while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {	while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {
push(@{$self->{'rows'}},$1) if ($cell =~ /^A(\d+)/ && $1 != 0);	push(@{$self->{'rows'}},$1) if ($cell =~ /^A(\d+)/ && $1 != 0);
push(@{$self->{'template_cells'}},$1) if ($cell =~ /^template_(\w+)/);	push(@{$self->{'template_cells'}},$1) if ($cell =~ /^template_(\w+)/);
Line 1190 sub calcerror {	Line 1207 sub calcerror {
sub display {	sub display {
my $self = shift;	my $self = shift;
my ($r) = @_;	my ($r) = @_;
$self->compute($r);
my $outputmode = 'html';	my $outputmode = 'html';
if ($ENV{'form.output_format'} =~ /^(html\|excel\|csv)$/) {	foreach ($self->output_options()) {
$outputmode = $ENV{'form.output_format'};	if ($env{'form.output_format'} eq $_->{'value'}) {
	$outputmode = $_->{'value'};
	last;
	}
}	}
	$self->{outputmode} = $outputmode;
if ($outputmode eq 'html') {	if ($outputmode eq 'html') {
	$self->compute($r);
	$self->outsheet_html($r);
	} elsif ($outputmode eq 'htmlclasslist') {
	# No computation neccessary... This is kludgy
	$self->outsheet_htmlclasslist($r);
	} elsif ($outputmode eq 'source') {
	# No computation necessary. Rumor has it that this is some
	# sort of kludge w.r.t. not "computing". It's also
	# a bit of of a kludge that we call "outsheet_html" and
	# let the 'outputmode' cause the outputting of source.
$self->outsheet_html($r);	$self->outsheet_html($r);
} elsif ($outputmode eq 'excel') {	} elsif ($outputmode eq 'excel') {
	$self->compute($r);
$self->outsheet_excel($r);	$self->outsheet_excel($r);
} elsif ($outputmode eq 'csv') {	} elsif ($outputmode eq 'csv') {
	$self->compute($r);
$self->outsheet_csv($r);	$self->outsheet_csv($r);
	} elsif ($outputmode eq 'xml') {
	# $self->compute($r);
	$self->outsheet_xml($r);
}	}
$self->cleanup();	$self->cleanup();
return;	return;
Line 1225 sub html_export_row {	Line 1260 sub html_export_row {
my $self = shift();	my $self = shift();
my ($color) = @_;	my ($color) = @_;
$color = '#CCCCFF' if (! defined($color));	$color = '#CCCCFF' if (! defined($color));
my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});	my $allowed = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
my $row_html;	my $row_html;
my @rowdata = $self->get_row(0);	my @rowdata = $self->get_row(0);
foreach my $cell (@rowdata) {	foreach my $cell (@rowdata) {
if ($cell->{'name'} =~ /^[A-Z]/) {	if ($cell->{'name'} =~ /^[A-Z]/) {
$row_html .= '<td bgcolor="'.$color.'">'.	$row_html .= '<td bgcolor="'.$color.'">'.
&html_editable_cell($cell,$color,$allowed).'</td>';	&html_editable_cell($cell,$color,$allowed,
	$self->{outputmode} eq 'source').'</td>';
} else {	} else {
$row_html .= '<td bgcolor="#DDCCFF">'.	$row_html .= '<td bgcolor="#DDCCFF">'.
&html_editable_cell($cell,'#DDCCFF',$allowed).'</td>';	&html_editable_cell($cell,'#DDCCFF',$allowed,
	$self->{outputmode} eq 'source').'</td>';
}	}
}	}
return $row_html;	return $row_html;
Line 1242 sub html_export_row {	Line 1279 sub html_export_row {

sub html_template_row {	sub html_template_row {
my $self = shift();	my $self = shift();
my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});	my $allowed = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
my ($num_uneditable,$importcolor) = @_;	my ($num_uneditable,$importcolor) = @_;
my $row_html;	my $row_html;
my @rowdata = $self->get_template_row();	my @rowdata = $self->get_template_row();
Line 1253 sub html_template_row {	Line 1290 sub html_template_row {
$row_html .= '<td bgcolor="'.$importcolor.'">'.	$row_html .= '<td bgcolor="'.$importcolor.'">'.
&html_uneditable_cell($cell,'#FFDDDD',$allowed).'</td>';	&html_uneditable_cell($cell,'#FFDDDD',$allowed).'</td>';
} else {	} else {
$row_html .= '<td bgcolor="#EOFFDD">'.	$row_html .= '<td bgcolor="#E0FFDD">'.
&html_editable_cell($cell,'#EOFFDD',$allowed).'</td>';	&html_editable_cell($cell,'#E0FFDD',$allowed,
	$self->{outputmode} eq 'source').'</td>';
}	}
}	}
return $row_html;	return $row_html;
}	}

sub html_editable_cell {	sub html_editable_cell {
my ($cell,$bgcolor,$allowed) = @_;	my ($cell,$bgcolor,$allowed,$showsource) = @_;
my $result;	my $result;
my ($name,$formula,$value);	my ($name,$formula,$value);
if (defined($cell)) {	if (defined($cell)) {
Line 1271 sub html_editable_cell {	Line 1309 sub html_editable_cell {
}	}
$name = '' if (! defined($name));	$name = '' if (! defined($name));
$formula = '' if (! defined($formula));	$formula = '' if (! defined($formula));
if (! defined($value)) {	if ($showsource) {
	if (!defined($formula) \|\| $formula =~ /^\s*$/) {
	$value = '<font color="'.$bgcolor.'">#</font>';
	} else {
	$value = &HTML::Entities::encode($formula, '<>&"');
	}
	} elsif (! defined($value)) {
$value = '<font color="'.$bgcolor.'">#</font>';	$value = '<font color="'.$bgcolor.'">#</font>';
if ($formula ne '') {	if ($formula ne '') {
$value = '<i>undefined value</i>';	$value = '<i>undefined value</i>';
Line 1279 sub html_editable_cell {	Line 1323 sub html_editable_cell {
} elsif ($value =~ /^\s*$/ ) {	} elsif ($value =~ /^\s*$/ ) {
$value = '<font color="'.$bgcolor.'">#</font>';	$value = '<font color="'.$bgcolor.'">#</font>';
} else {	} else {
$value = &HTML::Entities::encode($value) if ($value !~/ /);	$value = &HTML::Entities::encode($value,'<>&"') if ($value !~/ /);
}	}
return $value if (! $allowed);	return $value if (! $allowed);
#	#
Line 1302 sub html_editable_cell {	Line 1346 sub html_editable_cell {
sub html_uneditable_cell {	sub html_uneditable_cell {
my ($cell,$bgcolor) = @_;	my ($cell,$bgcolor) = @_;
my $value = (defined($cell) ? $cell->{'value'} : '');	my $value = (defined($cell) ? $cell->{'value'} : '');
$value = &HTML::Entities::encode($value) if ($value !~/ /);	$value = &HTML::Entities::encode($value,'<>&"') if ($value !~/ /);
return ' '.$value.' ';	return ' '.$value.' ';
}	}

sub html_row {	sub html_row {
my $self = shift();	my $self = shift();
my ($num_uneditable,$row,$exportcolor,$importcolor) = @_;	my ($num_uneditable,$row,$exportcolor,$importcolor) = @_;
my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});	my $allowed = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
my @rowdata = $self->get_row($row);	my @rowdata = $self->get_row($row);
my $num_cols_output = 0;	my $num_cols_output = 0;
my $row_html;	my $row_html;
Line 1323 sub html_row {	Line 1367 sub html_row {
$row_html .= '<td bgcolor="'.$color.'">';	$row_html .= '<td bgcolor="'.$color.'">';
$row_html .= &html_uneditable_cell($cell,'#FFDDDD');	$row_html .= &html_uneditable_cell($cell,'#FFDDDD');
} else {	} else {
$row_html .= '<td bgcolor="#EOFFDD">';	$row_html .= '<td bgcolor="#E0FFDD">';
$row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed);	$row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed,
	$self->{outputmode} eq 'source');
}	}
$row_html .= '</td>';	$row_html .= '</td>';
}	}
Line 1333 sub html_row {	Line 1378 sub html_row {

sub html_header {	sub html_header {
my $self = shift;	my $self = shift;
return '' if (! $ENV{'request.role.adv'});	return '' if (! $env{'request.role.adv'});
return "<table>\n".	return "<table>\n".
'<tr><th align="center">'.&mt('Output Format').'</th></tr>'."\n".	'<tr><th align="center">'.&mt('Output Format').'</th></tr>'."\n".
'<tr><td>'.&output_selector()."</td></tr>\n".	'<tr><td>'.$self->output_selector()."</td></tr>\n".
"</table>\n";	"</table>\n";
}	}

	##
	## Default output types are HTML, Excel, and CSV
	sub output_options {
	my $self = shift();
	return ({value => 'html',
	description => 'HTML'},
	{value => 'excel',
	description => 'Excel'},
	{value => 'source',
	description => 'Show Source'},
	# {value => 'xml',
	# description => 'XML'},
	{value => 'csv',
	description => 'Comma Separated Values'},);
	}

sub output_selector {	sub output_selector {
	my $self = shift();
my $output_selector = '<select name="output_format" size="3">'."\n";	my $output_selector = '<select name="output_format" size="3">'."\n";
my $default = 'html';	my $default = 'html';
if (exists($ENV{'form.output_format'})) {	if (exists($env{'form.output_format'})) {
$default = $ENV{'form.output_format'}	$default = $env{'form.output_format'}
} else {	} else {
$ENV{'form.output_format'} = $default;	$env{'form.output_format'} = $default;
}	}
foreach (['html','HTML'],	foreach ($self->output_options()) {
['excel','Excel'],	$output_selector.='<option value="'.$_->{'value'}.'"';
['csv','Comma Separated Values']) {	if ($_->{'value'} eq $default) {
my ($name,$description) = @{$_};
$output_selector.=qq{<option value="$name"};
if ($name eq $default) {
$output_selector .= ' selected';	$output_selector .= ' selected';
}	}
$output_selector .= ">".&mt($description)."</option>\n";	$output_selector .= ">".&mt($_->{'description'})."</option>\n";
}	}
$output_selector .= "</select>\n";	$output_selector .= "</select>\n";
return $output_selector;	return $output_selector;
Line 1380 sub excel_output_row {	Line 1439 sub excel_output_row {
return;	return;
}	}

sub create_excel_spreadsheet {	#
	# This routine is just a stub
	sub outsheet_htmlclasslist {
my $self = shift;	my $self = shift;
my ($r) = @_;	my ($r) = @_;
my $filename = '/prtspool/'.	$r->print('<h2>'.&mt("This output is not supported").'</h2>');
$ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.	$r->rflush();
time.'_'.rand(1000000000).'.xls';	return;
my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
if (! defined($workbook)) {
$r->log_error("Error creating excel spreadsheet $filename: $!");
$r->print(&mt("Problems creating new Excel file. ".
"This error has been logged. ".
"Please alert your LON-CAPA administrator"));
return undef;
}
#
# The excel spreadsheet stores temporary data in files, then put them
# together. If needed we should be able to disable this (memory only).
# The temporary directory must be specified before calling 'addworksheet'.
# File::Temp is used to determine the temporary directory.
$workbook->set_tempdir('/home/httpd/perl/tmp');
#
# Determine the name to give the worksheet
return ($workbook,$filename);
}	}

sub outsheet_excel {	sub outsheet_excel {
my $self = shift;	my $self = shift;
my ($r) = @_;	my ($r) = @_;
my $connection = $r->connection();	my $connection = $r->connection();
	#
	$r->print($self->html_report_error());
	$r->rflush();
	#
$r->print("<h2>".&mt('Preparing Excel Spreadsheet')."</h2>");	$r->print("<h2>".&mt('Preparing Excel Spreadsheet')."</h2>");
#	#
# Create excel worksheet	# Create excel workbook
my ($workbook,$filename) = $self->create_excel_spreadsheet($r);	my ($workbook,$filename,$format)=&Apache::loncommon::create_workbook($r);
return if (! defined($workbook));	return if (! defined($workbook));
#	#
# Create main worksheet	# Create main worksheet
Line 1423 sub outsheet_excel {	Line 1471 sub outsheet_excel {
# Write excel header	# Write excel header
foreach my $value ($self->get_title()) {	foreach my $value ($self->get_title()) {
$cols_output = 0;	$cols_output = 0;
$worksheet->write($rows_output++,$cols_output,$value);	$worksheet->write($rows_output++,$cols_output,$value,$format->{'h1'});
}	}
$rows_output++; # skip a line	$rows_output++; # skip a line
#	#
# Write summary/export row	# Write summary/export row
$cols_output = 0;	$cols_output = 0;
$self->excel_output_row($worksheet,0,$rows_output++,'Summary');	$self->excel_output_row($worksheet,0,$rows_output++,'Summary',
	$format->{'b'});
$rows_output++; # skip a line	$rows_output++; # skip a line
#	#
$self->excel_rows($connection,$worksheet,$cols_output,$rows_output);	$self->excel_rows($connection,$worksheet,$cols_output,$rows_output,
	$format);
#	#
#	#
# Close the excel file	# Close the excel file
Line 1451 sub outsheet_csv {	Line 1501 sub outsheet_csv {
my $self = shift;	my $self = shift;
my ($r) = @_;	my ($r) = @_;
my $connection = $r->connection();	my $connection = $r->connection();
	#
	$r->print($self->html_report_error());
	$r->rflush();
	#
my $csvdata = '';	my $csvdata = '';
my @Values;	my @Values;
#	#
# Open the csv file	# Open the csv file
my $filename = '/prtspool/'.	my $filename = '/prtspool/'.
$ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.	$env{'user.name'}.'_'.$env{'user.domain'}.'_'.
time.'_'.rand(1000000000).'.csv';	time.'_'.rand(1000000000).'.csv';
my $file;	my $file;
unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) {	unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) {
Line 1514 sub outsheet_xml {	Line 1568 sub outsheet_xml {
## Will be rendered for the user	## Will be rendered for the user
## But not on this day	## But not on this day
my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n";	my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n";
	$self->check_formulas_loaded();
while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {	while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {
if ($cell =~ /^template_(\d+)/) {	if ($cell =~ /^template_(\w+)/) {
my $col = $1;	my $col = $1;
$Str .= '<template col="'.$col.'">'.$formula.'</template>'."\n";	$Str .= '<template col="'.$col.'">'.$formula.'</template>'."\n";
} else {	} else {
my ($row,$col) = ($cell =~ /^([A-z])(\d+)/);	my ($col,$row) = ($cell =~ /^([A-z])(\d+)/);
next if (! defined($row) \|\| ! defined($col));	next if (! defined($row) \|\| ! defined($col));
$Str .= '<field row="'.$row.'" col="'.$col.'" >'.$formula.'</cell>'	next if ($row != 0);
	$Str .=
	'<field row="'.$row.'" col="'.$col.'" >'.$formula.'</field>'
."\n";	."\n";
}	}
}	}
$Str.="</spreadsheet>";	$Str.="</spreadsheet>";
	$r->print("<pre>\n\n\n".$Str."\n\n\n</pre>");
return $Str;	return $Str;
}	}

Line 1552 sub parse_sheet {	Line 1610 sub parse_sheet {
$formulas{$cell} = $formula;	$formulas{$cell} = $formula;
$sources{$cell} = $source if (defined($source));	$sources{$cell} = $source if (defined($source));
$parser->get_text('/field');	$parser->get_text('/field');
}	} elsif ($token->[1] eq 'template') {
if ($token->[1] eq 'template') {
$formulas{'template_'.$token->[2]->{'col'}}=	$formulas{'template_'.$token->[2]->{'col'}}=
$parser->get_text('/template');	$parser->get_text('/template');
}	}
Line 1594 sub load {	Line 1651 sub load {
my $stype = $self->{'type'};	my $stype = $self->{'type'};
my $cnum = $self->{'cnum'};	my $cnum = $self->{'cnum'};
my $cdom = $self->{'cdom'};	my $cdom = $self->{'cdom'};
my $chome = $self->{'chome'};
#	#
my $filename = $self->filename();	my $filename = $self->filename();
my $cachekey = join('_',($cnum,$cdom,$stype,$filename));	my $cachekey = join('_',($cnum,$cdom,$stype,$filename));
Line 1603 sub load {	Line 1659 sub load {
my ($formulas);	my ($formulas);
if (exists($spreadsheets{$cachekey})) {	if (exists($spreadsheets{$cachekey})) {
$formulas = $spreadsheets{$cachekey}->{'formulas'};	$formulas = $spreadsheets{$cachekey}->{'formulas'};
	$self->formulas($formulas);
	$self->{'row_source'}=$spreadsheets{$cachekey}->{'row_source'};
	$self->{'row_numbers'}=$spreadsheets{$cachekey}->{'row_numbers'};
	$self->{'maxrow'}=$spreadsheets{$cachekey}->{'maxrow'};
} else {	} else {
# Not cached, need to read	# Not cached, need to read
if (! defined($filename)) {	if (! defined($filename)) {
$formulas = $self->load_system_default_sheet();	$formulas = $self->load_system_default_sheet();
} elsif($self->filename() =~ /^\/res\/.*\.spreadsheet$/) {	} elsif($filename =~ /^\/res\/.*\.spreadsheet$/) {
# Load a spreadsheet definition file	# Load a spreadsheet definition file
my $sheetxml=&Apache::lonnet::getfile	my $sheetxml=&Apache::lonnet::getfile
(&Apache::lonnet::filelocation('',$filename));	(&Apache::lonnet::filelocation('',$filename));
Line 1628 sub load {	Line 1688 sub load {
# Load the spreadsheet definition file from the save file	# Load the spreadsheet definition file from the save file
my %tmphash = &Apache::lonnet::dump($filename,$cdom,$cnum);	my %tmphash = &Apache::lonnet::dump($filename,$cdom,$cnum);
my ($tmp) = keys(%tmphash);	my ($tmp) = keys(%tmphash);
if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {	if (%tmphash
	&& $tmp !~ /^(con_lost\|error\|no_such_host)/i) {
while (my ($cell,$formula) = each(%tmphash)) {	while (my ($cell,$formula) = each(%tmphash)) {
$formulas->{$cell}=$formula;	$formulas->{$cell}=$formula;
}	}
Line 1636 sub load {	Line 1697 sub load {
$formulas = $self->load_system_default_sheet();	$formulas = $self->load_system_default_sheet();
}	}
}	}
$filename=$self->filename(); # filename may have changed	$self->formulas($formulas);
$cachekey = join('_',($cnum,$cdom,$stype,$filename));	$self->set_row_sources();
%{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas};	$self->set_row_numbers();
	$self->cache_sheet($formulas);
}	}
$self->formulas($formulas);	}
$self->set_row_sources();
$self->set_row_numbers();	sub cache_sheet {
	my $self = shift;
	my ($formulas) = @_;
	my $stype = $self->{'type'};
	my $cnum = $self->{'cnum'};
	my $cdom = $self->{'cdom'};
	#
	my $filename = $self->filename();
	my $cachekey = join('_',($cnum,$cdom,$stype,$filename));

	if (ref($formulas) eq 'HASH') {
	%{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas};
	}
	if (ref($self->{'row_source'})) {
	%{$spreadsheets{$cachekey}->{'row_source'}} =%{$self->{'row_source'}};
	}
	if (ref($self->{'row_numbers'})) {
	%{$spreadsheets{$cachekey}->{'row_numbers'}}=%{$self->{'row_numbers'}};
	}
	$spreadsheets{$cachekey}->{'maxrow'} = $self->{'maxrow'};
}	}

sub set_row_sources {	sub set_row_sources {
my $self = shift;	my $self = shift;
	$self->check_formulas_loaded();
while (my ($cell,$value) = each(%{$self->{'formulas'}})) {	while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
next if ($cell !~ /^A(\d+)/ \|\| $1 < 1);	next if ($cell !~ /^A(\d+)/ \|\| $1 < 1);
my $row = $1;	my $row = $1;
Line 1657 sub set_row_sources {	Line 1739 sub set_row_sources {

sub set_row_numbers {	sub set_row_numbers {
my $self = shift;	my $self = shift;
	$self->check_formulas_loaded();
while (my ($cell,$value) = each(%{$self->{'formulas'}})) {	while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
next if ($cell !~ /^A(\d+)$/);	next if ($cell !~ /^A(\d+)$/);
next if (! defined($value));	next if (! defined($value));
Line 1691 sub save {	Line 1774 sub save {
my $stype = $self->{'type'};	my $stype = $self->{'type'};
my $cnum = $self->{'cnum'};	my $cnum = $self->{'cnum'};
my $cdom = $self->{'cdom'};	my $cdom = $self->{'cdom'};
my $chome = $self->{'chome'};
my $filename = $self->{'filename'};	my $filename = $self->{'filename'};
my $cachekey = join('_',($cnum,$cdom,$stype,$filename));
# Cache new sheet	# Cache new sheet
%{$spreadsheets{$cachekey}->{'formulas'}}=%f;	$self->cache_sheet(\%f);
# Write sheet	# Write sheet
foreach (keys(%f)) {	foreach (keys(%f)) {
delete($f{$_}) if ($f{$_} eq 'import');	delete($f{$_}) if ($f{$_} eq 'import');
Line 1703 sub save {	Line 1784 sub save {
my $reply = &Apache::lonnet::put($filename,\%f,$cdom,$cnum);	my $reply = &Apache::lonnet::put($filename,\%f,$cdom,$cnum);
return $reply if ($reply ne 'ok');	return $reply if ($reply ne 'ok');
$reply = &Apache::lonnet::put($stype.'_spreadsheets',	$reply = &Apache::lonnet::put($stype.'_spreadsheets',
{$filename => $ENV{'user.name'}.'@'.$ENV{'user.domain'}},	{$filename => $env{'user.name'}.'@'.$env{'user.domain'}},
$cdom,$cnum);	$cdom,$cnum);
return $reply if ($reply ne 'ok');	return $reply if ($reply ne 'ok');
if ($makedef) {	if ($makedef) {
Line 1711 sub save {	Line 1792 sub save {
{'spreadsheet_default_'.$stype => $filename },	{'spreadsheet_default_'.$stype => $filename },
$cdom,$cnum);	$cdom,$cnum);
return $reply if ($reply ne 'ok');	return $reply if ($reply ne 'ok');
	&Apache::lonnet::appenv('course.'.$self->{'cid'}.'.spreadsheet_default_'.
	$self->{'type'} => $self->filename());
}	}
if ($self->is_default()) {	if ($self->is_default()) {
if ($self->{'type'} eq 'studentcalc') {	if ($self->{'type'} eq 'studentcalc') {
Line 1729 sub save {	Line 1812 sub save {

sub save_tmp {	sub save_tmp {
my $self = shift;	my $self = shift;
my $filename=$ENV{'user.name'}.'_'.	my $filename=$env{'user.name'}.'_'.
$ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.	$env{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.
$self->{'filename'};	$self->{'filename'};
$filename=~s/\W/\_/g;	$filename=~s/\W/\_/g;
$filename=$Apache::lonnet::tmpdir.$filename.'.tmp';	$filename=$Apache::lonnet::tmpdir.$filename.'.tmp';
Line 1740 sub save_tmp {	Line 1823 sub save_tmp {
my %f = $self->formulas();	my %f = $self->formulas();
while( my ($cell,$formula) = each(%f)) {	while( my ($cell,$formula) = each(%f)) {
next if ($formula eq 'import');	next if ($formula eq 'import');
print $fh &Apache::lonnet::escape($cell)."=".	print $fh &escape($cell)."=".
&Apache::lonnet::escape($formula)."\n";	&escape($formula)."\n";
}	}
$fh->close();	$fh->close();
}	}
Line 1749 sub save_tmp {	Line 1832 sub save_tmp {

sub load_tmp {	sub load_tmp {
my $self = shift;	my $self = shift;
my $filename=$ENV{'user.name'}.'_'.	my $filename=$env{'user.name'}.'_'.
$ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.	$env{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.
$self->{'filename'};	$self->{'filename'};
$filename=~s/\W/\_/g;	$filename=~s/\W/\_/g;
$filename=$Apache::lonnet::tmpdir.$filename.'.tmp';	$filename=$Apache::lonnet::tmpdir.$filename.'.tmp';
Line 1759 sub load_tmp {	Line 1842 sub load_tmp {
while (<$spreadsheet_file>) {	while (<$spreadsheet_file>) {
chomp;	chomp;
my ($cell,$formula) = split(/=/);	my ($cell,$formula) = split(/=/);
$cell = &Apache::lonnet::unescape($cell);	$cell = &unescape($cell);
$formula = &Apache::lonnet::unescape($formula);	$formula = &unescape($formula);
$formulas{$cell} = $formula;	$formulas{$cell} = $formula;
}	}
$spreadsheet_file->close();	$spreadsheet_file->close();
Line 1803 sub othersheets {	Line 1886 sub othersheets {
my ($stype) = @_;	my ($stype) = @_;
$stype = $self->{'type'} if (! defined($stype) \|\| $stype !~ /calc$/);	$stype = $self->{'type'} if (! defined($stype) \|\| $stype !~ /calc$/);
#	#
my @alternatives=();	my @alternatives=(&mt('Default'), &mt('LON-CAPA Standard'));
my %results=&Apache::lonnet::dump($stype.'_spreadsheets',	my %results=&Apache::lonnet::dump($stype.'_spreadsheets',
$self->{'cdom'}, $self->{'cnum'});	$self->{'cdom'}, $self->{'cnum'});
my ($tmp) = keys(%results);	my ($tmp) = keys(%results);
if ($tmp =~ /^(con_lost\|error\|no_such_host)/i ) {	if (%results
@alternatives = (&mt('Default'));	&& $tmp =~ /^(con_lost\|error\|no_such_host)/i ) {
} else {	push(@alternatives, sort(keys(%results)));
@alternatives = (&mt('Default'), sort (keys(%results)));
}	}
return @alternatives;	return @alternatives;
}	}

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

Removed from v.1.30
changed lines
	Added in v.1.71