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.27 and 1.69

version 1.27, 2003/09/16 15:36:32	version 1.69, 2006/05/30 12:46:26
Line 59 use HTML::Entities();	Line 59 use HTML::Entities();
use HTML::TokeParser;	use HTML::TokeParser;
use Spreadsheet::WriteExcel;	use Spreadsheet::WriteExcel;
use Time::HiRes;	use Time::HiRes;
	use Apache::lonlocal;
	use lib '/home/httpd/lib/perl/';
	use LONCAPA;


##	##
## Package Variables	## Package Variables
Line 84 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 116 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 150 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'};
}	}
Line 159 sub filename {	Line 175 sub filename {
if ($newfilename !~ /\w/ \|\| $newfilename =~ /^\W*$/) {	if ($newfilename !~ /\w/ \|\| $newfilename =~ /^\W*$/) {
$newfilename = 'default_'.$self->{'type'};	$newfilename = 'default_'.$self->{'type'};
}	}
if ($newfilename !~ /^default\.$self->{'type'}$/ ) {	if ($newfilename !~ /^default\.$self->{'type'}$/ &&
	$newfilename !~ /^\/res\/(.*)spreadsheet$/) {
if ($newfilename !~ /_$self->{'type'}$/) {	if ($newfilename !~ /_$self->{'type'}$/) {
$newfilename =~ s/[\s_]*$//;	$newfilename =~ s/[\s_]*$//;
$newfilename .= '_'.$self->{'type'};	$newfilename .= '_'.$self->{'type'};
Line 189 sub make_default {	Line 206 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 209 course environment. Returns 0 otherwise	Line 228 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 248 sub initialize_spreadsheet_package {	Line 259 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 305 Returns the safe space required by a Spr	Line 316 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 312 sub initialize_safe_space {	Line 326 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 324 sub initialize_safe_space {	Line 343 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 350 $filename = '';	Line 366 $filename = '';
#	#
# user data	# user data
$name = '';	$name = '';
$uhome = '';
$domain = '';	$domain = '';
#	#
# course data	# course data
$csec = '';	$csec = '';
$chome= '';
$cnum = '';	$cnum = '';
$cdom = '';	$cdom = '';
$cid = '';	$cid = '';
Line 371 $errormsg = '';	Line 385 $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 379 returns the number of items in the range	Line 414 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 395 sub NUM {	Line 430 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 417 returns the sum of items in the range.	Line 452 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 437 compute the average of the items in the	Line 472 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 463 compute the standard deviation of the it	Line 498 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 490 compute the product of the items in the	Line 525 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 510 compute the maximum of the items in the	Line 545 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 533 compute the minimum of the items in the	Line 567 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 558 compute the sum of the largest 'num' ite	Line 591 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 585 compute the sum of the smallest 'num' it	Line 614 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 613 parametername should be a string such as	Line 638 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 638 parametername should be a string such as	Line 662 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 648 sub MAXPARM {	Line 671 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 677 sub calc {	Line 756 sub calc {
return $lastcalc.': Maximum calculation depth exceeded';	return $lastcalc.': Maximum calculation depth exceeded';
}	}
}	}
return '';	return 'okay';
}	}

# ------------------------------------------- End of "Inside of the safe space"	# ------------------------------------------- End of "Inside of the safe space"
Line 690 ENDDEFS	Line 769 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 710 ENDDEFS	Line 790 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 829 sub expandnamed {	Line 823 sub expandnamed {
$result.=$thissum.'+';	$result.=$thissum.'+';
}	}
$result=~s/\+$//;	$result=~s/\+$//;
return $result;	return '('.$result.')';
} else {	} else {
return 0;	return 0;
}	}
Line 844 sub expandnamed {	Line 838 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 876 sub expandnamed {	Line 869 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 906 sub sett {	Line 900 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 927 sub sett {	Line 922 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 984 sub formulas {	Line 979 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 1002 sub set_formula {	Line 1014 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 1013 sub formulas_keys {	Line 1025 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 1091 sub rebuild_stats {	Line 1104 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 1138 sub calcsheet {	Line 1152 sub calcsheet {
# $self->logthis($self->get_errorlog());	# $self->logthis($self->get_errorlog());
%{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')};	%{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')};
# $self->logthis($self->get_errorlog());	# $self->logthis($self->get_errorlog());
	if ($result ne 'okay') {
	$self->set_calcerror($result);
	}
return $result;	return $result;
}	}

	sub set_badcalc {
	my $self = shift();
	$self->{'badcalc'} =1;
	return;
	}

	sub badcalc {
	my $self = shift;
	if (exists($self->{'badcalc'}) && $self->{'badcalc'}) {
	return 1;
	} else {
	return 0;
	}
	}

	sub set_calcerror {
	my $self = shift;
	if (@_) {
	$self->set_badcalc();
	if (exists($self->{'calcerror'})) {
	$self->{'calcerror'}.="\n".$_[0];
	} else {
	$self->{'calcerror'}.=$_[0];
	}
	}
	}

	sub calcerror {
	my $self = shift;
	if ($self->badcalc()) {
	if (exists($self->{'calcerror'})) {
	return $self->{'calcerror'};
	}
	}
	return;
	}

###########################################################	###########################################################
##	##
## Output Helpers	## Output Helpers
Line 1149 sub calcsheet {	Line 1203 sub calcsheet {
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 1168 sub display {	Line 1240 sub display {
############################################	############################################
## HTML output routines ##	## HTML output routines ##
############################################	############################################
	sub html_report_error {
	my $self = shift();
	my $Str = '';
	if ($self->badcalc()) {
	$Str = '<h3 style="color:red">'.
	&mt('An error occurred while calculating this spreadsheet').
	"</h3>\n".
	'<pre>'.$self->calcerror()."</pre>\n";
	}
	return $Str;
	}

sub html_export_row {	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 1189 sub html_export_row {	Line 1275 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 1201 sub html_template_row {	Line 1287 sub html_template_row {
&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="#EOFFDD">'.
&html_editable_cell($cell,'#EOFFDD',$allowed).'</td>';	&html_editable_cell($cell,'#EOFFDD',$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 1218 sub html_editable_cell {	Line 1305 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 1226 sub html_editable_cell {	Line 1319 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 1249 sub html_editable_cell {	Line 1342 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 1271 sub html_row {	Line 1364 sub html_row {
$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="#EOFFDD">';
$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 1280 sub html_row {	Line 1374 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">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 Seperated 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 .= ">$description</option>\n";	$output_selector .= ">".&mt($_->{'description'})."</option>\n";
}	}
$output_selector .= "</select>\n";	$output_selector .= "</select>\n";
return $output_selector;	return $output_selector;
Line 1327 sub excel_output_row {	Line 1435 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("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("<h2>Preparing Excel Spreadsheet</h2>");
#	#
# Create excel worksheet	$r->print($self->html_report_error());
my ($workbook,$filename) = $self->create_excel_spreadsheet($r);	$r->rflush();
	#
	$r->print("<h2>".&mt('Preparing Excel Spreadsheet')."</h2>");
	#
	# Create excel workbook
	my ($workbook,$filename,$format)=&Apache::loncommon::create_workbook($r);
return if (! defined($workbook));	return if (! defined($workbook));
#	#
# Create main worksheet	# Create main worksheet
Line 1370 sub outsheet_excel {	Line 1467 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 1398 sub outsheet_csv {	Line 1497 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)) {
$r->log_error("Couldn't open $filename for output $!");	$r->log_error("Couldn't open $filename for output $!");
$r->print("Problems occured in writing the csv file. ".	$r->print(&mt("Problems occured in writing the csv file. ".
"This error has been logged. ".	"This error has been logged. ".
"Please alert your LON-CAPA administrator.");	"Please alert your LON-CAPA administrator."));
$r->print("<pre>\n".$csvdata."</pre>\n");	$r->print("<pre>\n".$csvdata."</pre>\n");
return 0;	return 0;
}	}
Line 1426 sub outsheet_csv {	Line 1529 sub outsheet_csv {
# Close the csv file	# Close the csv file
close($file);	close($file);
$r->print('<br /><br />'.	$r->print('<br /><br />'.
'<a href="'.$filename.'">Your CSV spreadsheet.</a>'."\n");	'<a href="'.$filename.'">'.&mt('Your CSV spreadsheet.').'</a>'."\n");
#	#
return 1;	return 1;
}	}
Line 1461 sub outsheet_xml {	Line 1564 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 1499 sub parse_sheet {	Line 1606 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 1541 sub load {	Line 1647 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 1550 sub load {	Line 1655 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 1583 sub load {	Line 1692 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 1604 sub set_row_sources {	Line 1734 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 1617 sub set_row_numbers {	Line 1748 sub set_row_numbers {
##	##
sub exportrow {	sub exportrow {
my $self = shift;	my $self = shift;
	if (exists($self->{'badcalc'}) && $self->{'badcalc'}) {
	return ();
	}
my @exportarray;	my @exportarray;
foreach my $column (@UC_Columns) {	foreach my $column (@UC_Columns) {
push(@exportarray,$self->value($column.'0'));	push(@exportarray,$self->value($column.'0'));
Line 1635 sub save {	Line 1769 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 1647 sub save {	Line 1779 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 1655 sub save {	Line 1787 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 1673 sub save {	Line 1807 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 1684 sub save_tmp {	Line 1818 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 1693 sub save_tmp {	Line 1827 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 1703 sub load_tmp {	Line 1837 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 1752 sub othersheets {	Line 1886 sub othersheets {
$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 ($tmp =~ /^(con_lost\|error\|no_such_host)/i ) {
@alternatives = ('Default');	@alternatives = (&mt('Default'));
} else {	} else {
@alternatives = ('Default', sort (keys(%results)));	@alternatives = (&mt('Default'), sort (keys(%results)));
}	}
return @alternatives;	return @alternatives;
}	}

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

Removed from v.1.27
changed lines
	Added in v.1.69