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.54

version 1.36, 2004/02/24 20:47:14	version 1.54, 2005/08/26 20:46:46
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 256 sub initialize_spreadsheet_package {	Line 250 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 307 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 317 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 334 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 357 $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 376 $errormsg = '';

=pod	=pod

	=item EXT(parameter)

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

	=cut

	#-------------------------------------------------------
	sub EXT {
	my ($parameter) = @_;
	return '' if (! defined($parameter) \|\| $parameter eq '');
	$parameter =~ s/^parameter\./resource\./;
	my $value = &Apache::lonnet::EXT($parameter,$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 403 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 419 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 441 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 461 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 487 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 514 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 534 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 556 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 580 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 603 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 660 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 = '(\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 758 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 779 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 881 sub expandnamed {	Line 858 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 889 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 911 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 968 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 1003 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 1014 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 1093 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 1194 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;
}	}
Line 1240 sub html_export_row {	Line 1238 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) {
Line 1257 sub html_export_row {	Line 1255 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 1294 sub html_editable_cell {	Line 1292 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 1315 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 1348 sub html_row {	Line 1346 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 1373 sub output_selector {	Line 1371 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 1405 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 1425 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 1437 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 1476 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 1534 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 1617 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 1625 sub load {
my ($formulas);	my ($formulas);
if (exists($spreadsheets{$cachekey})) {	if (exists($spreadsheets{$cachekey})) {
$formulas = $spreadsheets{$cachekey}->{'formulas'};	$formulas = $spreadsheets{$cachekey}->{'formulas'};
} else {	$self->formulas($formulas);
	$self->{'row_source'}=$spreadsheets{$cachekey}->{'row_source'};
	$self->{'row_numbers'}=$spreadsheets{$cachekey}->{'row_numbers'};
	$self->{'maxrow'}=$spreadsheets{$cachekey}->{'maxrow'};
	} 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();
Line 1684 sub load {	Line 1663 sub load {
}	}
}	}
$filename=$self->filename(); # filename may have changed	$filename=$self->filename(); # filename may have changed
$cachekey = join('_',($cnum,$cdom,$stype,$filename));	$cachekey = join('_',($cnum,$cdom,$stype,$filename));
%{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas};	if (ref($formulas) eq 'HASH') {
	%{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas};
	}
	$self->formulas($formulas);
	$self->set_row_sources();
	$self->set_row_numbers();
	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'};
}	}
$self->formulas($formulas);
$self->set_row_sources();
$self->set_row_numbers();
}	}

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 1695 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 1730 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));	my $cachekey = join('_',($cnum,$cdom,$stype,$filename));
# Cache new sheet	# Cache new sheet
Line 1750 sub save {	Line 1741 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 1776 sub save {	Line 1767 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 1787 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.54