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.36 and 1.65

version 1.36, 2004/02/24 20:47:14	version 1.65, 2006/03/05 21:38:27
Line 86 sub new {	Line 86 sub new {
my ($stype) = ($class =~ /Apache::(.*)$/);	my ($stype) = ($class =~ /Apache::(.*)$/);
#	#
my ($name,$domain,$filename,$usymb)=@_;	my ($name,$domain,$filename,$usymb)=@_;
	if (defined($usymb) && ref($usymb)) {
	$usymb = $usymb->symb;
	}
if (! defined($name) \|\| $name eq '') {	if (! defined($name) \|\| $name eq '') {
$name = $ENV{'user.name'};	$name = $env{'user.name'};
}	}
if (! defined($domain) \|\| $domain eq '') {	if (! defined($domain) \|\| $domain eq '') {
$domain = $ENV{'user.domain'};	$domain = $env{'user.domain'};
}	}
#	#
my $self = {	my $self = {
Line 100 sub new {	Line 103 sub new {
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 123 sub new {	Line 126 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 157 sub filename {	Line 151 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 197 sub make_default {	Line 191 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 217 course environment. Returns 0 otherwise	Line 213 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 256 sub initialize_spreadsheet_package {	Line 244 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 313 Returns the safe space required by a Spr	Line 301 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 320 sub initialize_safe_space {	Line 311 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 332 sub initialize_safe_space {	Line 328 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 358 $filename = '';	Line 351 $filename = '';
#	#
# user data	# user data
$name = '';	$name = '';
$uhome = '';
$domain = '';	$domain = '';
#	#
# course data	# course data
$csec = '';	$csec = '';
$chome= '';
$cnum = '';	$cnum = '';
$cdom = '';	$cdom = '';
$cid = '';	$cid = '';
Line 379 $errormsg = '';	Line 370 $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 387 returns the number of items in the range	Line 399 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 403 sub NUM {	Line 415 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 425 returns the sum of items in the range.	Line 437 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 445 compute the average of the items in the	Line 457 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 471 compute the standard deviation of the it	Line 483 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 498 compute the product of the items in the	Line 510 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 518 compute the maximum of the items in the	Line 530 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 541 compute the minimum of the items in the	Line 552 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 566 compute the sum of the largest 'num' ite	Line 576 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 593 compute the sum of the smallest 'num' it	Line 599 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 654 sub MAXPARM {	Line 656 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 696 ENDDEFS	Line 754 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 716 ENDDEFS	Line 775 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 835 sub expandnamed {	Line 808 sub expandnamed {
$result.=$thissum.'+';	$result.=$thissum.'+';
}	}
$result=~s/\+$//;	$result=~s/\+$//;
return $result;	return '('.$result.')';
} else {	} else {
return 0;	return 0;
}	}
Line 881 sub expandnamed {	Line 854 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 911 sub sett {	Line 885 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 932 sub sett {	Line 907 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 989 sub formulas {	Line 964 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 1007 sub set_formula {	Line 999 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 1018 sub formulas_keys {	Line 1010 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 1096 sub rebuild_stats {	Line 1089 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 1196 sub display {	Line 1190 sub display {
my ($r) = @_;	my ($r) = @_;
my $outputmode = 'html';	my $outputmode = 'html';
foreach ($self->output_options()) {	foreach ($self->output_options()) {
if ($ENV{'form.output_format'} eq $_->{'value'}) {	if ($env{'form.output_format'} eq $_->{'value'}) {
$outputmode = $_->{'value'};	$outputmode = $_->{'value'};
last;	last;
}	}
}	}
	$self->{outputmode} = $outputmode;
if ($outputmode eq 'html') {	if ($outputmode eq 'html') {
$self->compute($r);	$self->compute($r);
$self->outsheet_html($r);	$self->outsheet_html($r);
} elsif ($outputmode eq 'htmlclasslist') {	} elsif ($outputmode eq 'htmlclasslist') {
# No computation neccessary... This is kludgy	# No computation neccessary... This is kludgy
$self->outsheet_htmlclasslist($r);	$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);
} elsif ($outputmode eq 'excel') {	} elsif ($outputmode eq 'excel') {
$self->compute($r);	$self->compute($r);
$self->outsheet_excel($r);	$self->outsheet_excel($r);
Line 1240 sub html_export_row {	Line 1241 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 1257 sub html_export_row {	Line 1260 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 1269 sub html_template_row {	Line 1272 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 1286 sub html_editable_cell {	Line 1290 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 1294 sub html_editable_cell {	Line 1304 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 1317 sub html_editable_cell {	Line 1327 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 1339 sub html_row {	Line 1349 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 1348 sub html_row {	Line 1359 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>'.$self->output_selector()."</td></tr>\n".	'<tr><td>'.$self->output_selector()."</td></tr>\n".
Line 1363 sub output_options {	Line 1374 sub output_options {
description => 'HTML'},	description => 'HTML'},
{value => 'excel',	{value => 'excel',
description => 'Excel'},	description => 'Excel'},
	{value => 'source',
	description => 'Show Source'},
# {value => 'xml',	# {value => 'xml',
# description => 'XML'},	# description => 'XML'},
{value => 'csv',	{value => 'csv',
Line 1373 sub output_selector {	Line 1386 sub output_selector {
my $self = shift();	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 ($self->output_options()) {	foreach ($self->output_options()) {
$output_selector.='<option value="'.$_->{'value'}.'"';	$output_selector.='<option value="'.$_->{'value'}.'"';
Line 1407 sub excel_output_row {	Line 1420 sub excel_output_row {
return;	return;
}	}

sub create_excel_spreadsheet {
my $self = shift;
my ($r) = @_;
my $filename = '/prtspool/'.
$ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
time.'_'.rand(1000000000).'.xls';
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);
}

#	#
# This routine is just a stub	# This routine is just a stub
sub outsheet_htmlclasslist {	sub outsheet_htmlclasslist {
Line 1452 sub outsheet_excel {	Line 1440 sub outsheet_excel {
#	#
$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 1464 sub outsheet_excel {	Line 1452 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 1501 sub outsheet_csv {	Line 1491 sub outsheet_csv {
#	#
# 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 1559 sub outsheet_xml {	Line 1549 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_(\w+)/) {	if ($cell =~ /^template_(\w+)/) {
my $col = $1;	my $col = $1;
Line 1641 sub load {	Line 1632 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 1650 sub load {	Line 1640 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)) {
Line 1683 sub load {	Line 1677 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 1704 sub set_row_sources {	Line 1719 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 1738 sub save {	Line 1754 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 1750 sub save {	Line 1764 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 1758 sub save {	Line 1772 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 1776 sub save {	Line 1792 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 1796 sub save_tmp {	Line 1812 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';

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

Removed from v.1.36
changed lines
	Added in v.1.65