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.10 and 1.59

version 1.10, 2003/05/28 17:38:57	version 1.59, 2005/12/06 06:04:49
Line 48 Spreadsheet	Line 48 Spreadsheet
package Apache::Spreadsheet;	package Apache::Spreadsheet;

use strict;	use strict;
	#use warnings FATAL=>'all';
	#no warnings 'uninitialized';
use Apache::Constants qw(:common :http);	use Apache::Constants qw(:common :http);
use Apache::lonnet;	use Apache::lonnet;
use Safe;	use Safe;
Line 57 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;

##	##
## Package Variables	## Package Variables
Line 83 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 '') {
	$name = $env{'user.name'};
	}
	if (! defined($domain) \|\| $domain eq '') {
	$domain = $env{'user.domain'};
	}
#	#
my $self = {	my $self = {
name => $name,	name => $name,
Line 90 sub new {	Line 102 sub new {
type => $stype,	type => $stype,
symb => $usymb,	symb => $usymb,
errorlog => '',	errorlog => '',
maxrow => '',	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'},	#
temporary => '',	# Flags
	temporary => 0, # true if this sheet has been modified but not saved
	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 111 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 142 sub filename {	Line 148 sub filename {
if (@_) {	if (@_) {
my ($newfilename) = @_;	my ($newfilename) = @_;
if (! defined($newfilename) \|\| $newfilename eq 'Default' \|\|	if (! defined($newfilename) \|\| $newfilename eq 'Default' \|\|
$newfilename !~ /\w/) {	$newfilename !~ /\w/ \|\| $newfilename eq '') {
my %tmphash = &Apache::lonnet::get('environment',	my $key = 'course.'.$self->{'cid'}.'.spreadsheet_default_'.
['spreadsheet_default_'.	$self->{'type'};
$self->{'type'}],	if (exists($env{$key}) && $env{$key} ne '') {
$self->{'cdom'},	$newfilename = $env{$key};
$self->{'cnum'});	} else {
my ($tmp) = keys(%tmphash);	$newfilename = 'default_'.$self->{'type'};
if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {
$newfilename=$tmphash{'spreadsheet_default_'.$self->{'type'}};
}
if (! defined($newfilename) \|\|
$newfilename !~ /\w/ \|\|
$newfilename =~ /^\W*$/) {
$newfilename = 'default.'.$self->{'type'};
}	}
} elsif ($newfilename !~ /^\/res\/.*\.spreadsheet/ &&	}
$newfilename !~ /^default\.$self->{'type'}$/ ) {	if ($newfilename !~ /\w/ \|\| $newfilename =~ /^\W*$/) {
my $regexp = '_'.$self->{'type'}.'$';	$newfilename = 'default_'.$self->{'type'};
if ($newfilename !~ /$regexp/) {	}
	if ($newfilename !~ /^default\.$self->{'type'}$/ &&
	$newfilename !~ /^\/res\/(.*)spreadsheet$/) {
	if ($newfilename !~ /_$self->{'type'}$/) {
	$newfilename =~ s/[\s_]*$//;
$newfilename .= '_'.$self->{'type'};	$newfilename .= '_'.$self->{'type'};
}	}
}	}
Line 185 default spreadsheets.......!	Line 188 default spreadsheets.......!
sub make_default {	sub make_default {
my $self = shift();	my $self = shift();
my $result = &Apache::lonnet::put('environment',	my $result = &Apache::lonnet::put('environment',
{'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 208 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_'.	if ($default_filename =~ /^\s*$/) {
$self->{'type'}],	$default_filename = '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'}};
}	}
return 1 if ($self->filename() eq $default_filename);	return 1 if ($self->filename() eq $default_filename);
return 0;	return 0;
}	}

	sub initialize {
	# This method is here to remind you that it will be overridden by
	# the descendents of the spreadsheet class.
	}

	sub clear_package {
	# This method is here to remind you that it will be overridden by
	# the descendents of the spreadsheet class.
	}

	sub cleanup {
	my $self = shift();
	$self->clear_package();
	}

sub initialize_spreadsheet_package {	sub initialize_spreadsheet_package {
&load_spreadsheet_expirationdates();	&load_spreadsheet_expirationdates();
&clear_spreadsheet_definition_cache();	&clear_spreadsheet_definition_cache();
Line 229 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 241 sub load_spreadsheet_expirationdates {	Line 256 sub load_spreadsheet_expirationdates {
sub check_expiration_time {	sub check_expiration_time {
my $self = shift;	my $self = shift;
my ($time)=@_;	my ($time)=@_;
my ($key1,$key2,$key3,$key4);	return 0 if (! defined($time));
	my ($key1,$key2,$key3,$key4,$key5);
	# Description of keys
	#
	# key1: all sheets of this type have expired
	# key2: all sheets of this type for this student
	# key3: all sheets of this type in this map for this student
	# key4: this assessment sheet for this student
	# key5: this assessment sheet for all students
$key1 = '::'.$self->{'type'}.':';	$key1 = '::'.$self->{'type'}.':';
$key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':';	$key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':';
$key3 = $key2.$self->{'container'} if (defined($self->{'container'}));	$key3 = $key2.$self->{'container'} if (defined($self->{'container'}));
$key4 = $key2.$self->{'usymb'} if (defined($self->{'usymb'}));	$key4 = $key2.$self->{'symb'} if (defined($self->{'symb'}));
foreach my $key ($key1,$key2,$key3,$key4) {	$key5 = $key1.$self->{'symb'} if (defined($self->{'symb'}));
	my $returnvalue = 1; # default to okay
	foreach my $key ($key1,$key2,$key3,$key4,$key5) {
next if (! defined($key));	next if (! defined($key));
if (exists($expiredates{$key}) &&$expiredates{$key} > $time) {	if (exists($expiredates{$key}) && $expiredates{$key} > $time) {
return 0;	$returnvalue = 0; # need to recompute
}	}
}	}
return 1;	return $returnvalue;
}	}

######################################################	######################################################
Line 270 Returns the safe space required by a Spr	Line 295 Returns the safe space required by a Spr
=cut	=cut

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

	my $safeeval;

sub initialize_safe_space {	sub initialize_safe_space {
my $self = shift;	my $self = shift;
my $safeeval = new Safe(shift);	my $usection = &Apache::lonnet::getsection($self->{'domain'},
my $safehole = new Safe::Hole;	$self->{'name'},
$safeeval->permit("entereval");	$env{'request.course.id'});
$safeeval->permit(":base_math");	if (! defined($safeeval)) {
$safeeval->permit("sort");	$safeeval = new Safe(shift);
$safeeval->deny(":base_io");	my $safehole = new Safe::Hole;
$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');	$safeeval->permit("entereval");
$safehole->wrap(\&mask,$safeeval,'&mask');	$safeeval->permit(":base_math");
$safeeval->share('$@');	$safeeval->permit("sort");
my $code=<<'ENDDEFS';	$safeeval->deny(":base_io");
	$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&Apache::lonnet::EXT');
	$safehole->wrap(\&mask,$safeeval,'&mask');
	$safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&logthis');
	$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';
# ---------------------------------------------------- Inside of the safe space	# ---------------------------------------------------- Inside of the safe space
#	#
# f: formulas	# f: formulas
Line 290 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 316 $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 337 $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) = @_;
	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 345 returns the number of items in the range	Line 397 returns the number of items in the range

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

Line 361 sub NUM {	Line 413 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 /$mask/,keys(%sheet_values)) {	foreach (@$values) {
if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {	if (($_>=$low) && ($_<=$high)) {
$num++;	$num++;
}	}
}	}
Line 383 returns the sum of items in the range.	Line 435 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 /$mask/,keys(%sheet_values)) {	foreach (@$values) {
$sum+=$sheet_values{$_};	$sum+=$_;
}	}
return $sum;	return $sum;
}	}
Line 403 compute the average of the items in the	Line 455 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 /$mask/,keys(%sheet_values)) {	foreach (@$values) {
$sum+=$sheet_values{$_};	$sum+=$_;
$num++;	$num++;
}	}
if ($num) {	if ($num) {
Line 429 compute the standard deviation of the it	Line 481 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 /$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 /$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 456 compute the product of the items in the	Line 508 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 /$mask/,keys(%sheet_values)) {	foreach (@$values) {
$prod*=$sheet_values{$_};	$prod*=$_;
}	}
return $prod;	return $prod;
}	}
Line 476 compute the maximum of the items in the	Line 528 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 /$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 499 compute the minimum of the items in the	Line 550 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 /$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 524 compute the sum of the largest 'num' ite	Line 574 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 /$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 551 compute the sum of the smallest 'num' it	Line 597 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 /$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 579 parametername should be a string such as	Line 621 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 604 parametername should be a string such as	Line 645 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 614 sub MAXPARM {	Line 654 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 643 sub calc {	Line 739 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"
ENDDEFS	ENDDEFS
$safeeval->reval($code);	$safeeval->reval($code);
	}
$self->{'safe'} = $safeeval;	$self->{'safe'} = $safeeval;
$self->{'root'} = $self->{'safe'}->root();	$self->{'root'} = $self->{'safe'}->root();
#	#
# 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;
}	}

	}

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

=pod	=pod
Line 672 ENDDEFS	Line 773 ENDDEFS

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


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


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

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-Za-z]\|\)(\d+\|\)/);
my ($ua,$ud) = ($upper=~/([A-Za-z]\|\)(\d+\|\)/);
#
my $alpha='';
my $num='';
#
if (($la eq '') \|\| ($ua eq '')) {
$alpha='[A-Za-z]';
} else {
if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) \|\|
($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
$alpha='['.$la.'-'.$ua.']';
} else {
$alpha='['.$la.'-Za-'.$ua.']';
}
}
if (($ld eq '') \|\| ($ud eq '')) {
$num='\d+';
} else {
if (length($ld)!=length($ud)) {
$num.='(';
foreach ($ld=~m/\d/g) {
$num.='['.$_.'-9]';
}
if (length($ud)-length($ld)>1) {
$num.='\|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
}
$num.='\|';
foreach ($ud=~m/\d/g) {
$num.='[0-'.$_.']';
}
$num.=')';
} else {
my @lda=($ld=~m/\d/g);
my @uda=($ud=~m/\d/g);
my $i;
my $j=0;
my $notdone=1;
for ($i=0;($i<=$#lda)&&($notdone);$i++) {
if ($lda[$i]==$uda[$i]) {
$num.=$lda[$i];
$j=$i;
} else {
$notdone=0;
}
}
if ($j<$#lda-1) {
$num.='('.$lda[$j+1];
for ($i=$j+2;$i<=$#lda;$i++) {
$num.='['.$lda[$i].'-9]';
}
if ($uda[$j+1]-$lda[$j+1]>1) {
$num.='\|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
($#lda-$j-1).'}';
}
$num.='\|'.$uda[$j+1];
for ($i=$j+2;$i<=$#uda;$i++) {
$num.='[0-'.$uda[$i].']';
}
$num.=')';
} else {
if ($lda[-1]!=$uda[-1]) {
$num.='['.$lda[-1].'-'.$uda[-1].']';
}
}
}
}
my $expression ='^'.$alpha.$num."\$";
$memoizer{$key} = $expression;
return $expression;
}

}

##	##
## sub add_hash_to_safe {} # spreadsheet, would like to destroy	## sub add_hash_to_safe {} # spreadsheet, would like to destroy
##	##
Line 778 sub expandnamed {	Line 788 sub expandnamed {
my @vars=split(/\W+/,$formula);	my @vars=split(/\W+/,$formula);
my %values=();	my %values=();
foreach my $varname ( @vars ) {	foreach my $varname ( @vars ) {
if ($varname=~/\D/) {	if ($varname=~/^(parameter\|stores\|timestamp)/) {
$formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;	$formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
$varname=~s/$var/$[\\w:\\- ]\+$/g;	$varname=~s/$var/$[\\w:\\- ]\+$/g;
foreach (keys(%{$self->{'constants'}})) {	foreach (keys(%{$self->{'constants'}})) {
if ($_=~/$varname/) {	if ($_=~/$varname/) {
Line 809 sub expandnamed {	Line 819 sub expandnamed {
# 4. If there is a collision, return 'bad parameter name error'	# 4. If there is a collision, return 'bad parameter name error'
my $returnvalue = '';	my $returnvalue = '';
my @matches = ();	my @matches = ();
	my @values = ();
$#matches = -1;	$#matches = -1;
study $expression;	while (my($parameter,$value) = each(%{$self->{'constants'}})) {
my $parameter;	next if ($parameter !~ /$expression/);
foreach $parameter (keys(%{$self->{'constants'}})) {	push(@matches,$parameter);
push @matches,$parameter if ($parameter =~ /$expression/);	push(@values,$value);
}	}
if (scalar(@matches) == 0) {	if (scalar(@matches) == 0) {
$returnvalue = '""';#'"unmatched parameter: '.$parameter.'"';	$returnvalue = '""';#'"unmatched parameter: '.$parameter.'"';
} elsif (scalar(@matches) == 1) {	} elsif (scalar(@matches) == 1) {
# why do we not do this lookup here, instead of delaying it?	# why do we not do this lookup here, instead of delaying it?
$returnvalue = '$c{\''.$matches[0].'\'}';	$returnvalue = $values[0];
} elsif (scalar(@matches) > 0) {	} elsif (scalar(@matches) > 0) {
# more than one match. Look for a concise one	# more than one match. Look for a concise one
$returnvalue = "'non-unique parameter name : $expression'";	$returnvalue = "'non-unique parameter name : $expression'";
foreach (@matches) {	for (my $i=0; $i<=$#matches;$i++) {
if (/^$expression$/) {	if ($matches[$i] =~ /^$expression$/) {
# why do we not do this lookup here?	# why do we not do this lookup here?
$returnvalue = '$c{\''.$_.'\'}';	$returnvalue = $values[$i];
}	}
}	}
} else {	} else {
# There was a negative number of matches, which indicates	# There was a negative number of matches, which indicates
# something is wrong with reality. Better warn the user.	# something is wrong with reality. Better warn the user.
$returnvalue = '"bizzare parameter: '.$parameter.'"';	$returnvalue = '"bizzare parameter: '.$expression.'"';
}	}
return $returnvalue;	return $returnvalue;
}	}
Line 841 sub expandnamed {	Line 852 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 871 sub sett {	Line 883 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 892 sub sett {	Line 905 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 949 sub formulas {	Line 962 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 967 sub set_formula {	Line 997 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 978 sub formulas_keys {	Line 1008 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 1056 sub rebuild_stats {	Line 1087 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 1103 sub calcsheet {	Line 1135 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 1114 sub calcsheet {	Line 1186 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;
	}
}	}
if ($outputmode eq 'html') {	if ($outputmode eq 'html') {
	$self->compute($r);
$self->outsheet_html($r);	$self->outsheet_html($r);
	} elsif ($outputmode eq 'htmlclasslist') {
	# No computation neccessary... This is kludgy
	$self->outsheet_htmlclasslist($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();
return;	return;
}	}

############################################	############################################
## 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 $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});	my ($color) = @_;
	$color = '#CCCCFF' if (! defined($color));
	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="#CCCCFF">'.	$row_html .= '<td bgcolor="'.$color.'">'.
&html_editable_cell($cell,'#CCCCFF',$allowed).'</td>';	&html_editable_cell($cell,$color,$allowed).'</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).'</td>';
Line 1151 sub html_export_row {	Line 1249 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) = @_;	my ($num_uneditable,$importcolor) = @_;
my $row_html;	my $row_html;
my @rowdata = $self->get_template_row();	my @rowdata = $self->get_template_row();
my $count = 0;	my $count = 0;
for (my $i = 0; $i<=$#rowdata; $i++) {	for (my $i = 0; $i<=$#rowdata; $i++) {
my $cell = $rowdata[$i];	my $cell = $rowdata[$i];
if ($i < $num_uneditable) {	if ($i < $num_uneditable) {
$row_html .= '<td bgcolor="#FFDDDD">'.	$row_html .= '<td bgcolor="'.$importcolor.'">'.
&html_uneditable_cell($cell,'#FFDDDD',$allowed).'</td>';	&html_uneditable_cell($cell,'#FFDDDD',$allowed).'</td>';
} else {	} else {
$row_html .= '<td bgcolor="#EOFFDD">'.	$row_html .= '<td bgcolor="#EOFFDD">'.
Line 1188 sub html_editable_cell {	Line 1286 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);
# Make the formula safe for outputting	#
$formula =~ s/\'/\"/g;
# The formula will be parsed by the browser twice before being	# The formula will be parsed by the browser twice before being
# displayed to the user for editing.	# displayed to the user for editing.
$formula = &HTML::Entities::encode(&HTML::Entities::encode($formula));	#
# Escape newlines so they make it into the edit window	# The encoding string "^A-blah" is placed in []'s inside a regexp, so
$formula =~ s/\n/\\n/gs;	# we specify the characters we want left alone by putting a '^' in front.
	$formula = &HTML::Entities::encode($formula,'^A-z0-9 !#$%-;=?~');
	# HTML::Entities::encode does not catch everything - we need '\' encoded
	$formula =~ s/\\/&\#092/g;
	# Escape it again - this time the only encodable character is '&'
	$formula =~ s/\&/\&/g;
# Glue everything together	# Glue everything together
$result .= "<a href=\"javascript:celledit(\'".	$result .= "<a href=\"javascript:celledit(\'".
$name."','".$formula."');\">".$value."</a>";	$name."','".$formula."');\">".$value."</a>";
Line 1207 sub html_editable_cell {	Line 1309 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) = @_;	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;
	my $color = $importcolor;
	if ($row == 0) {
	$color = $exportcolor;
	}
	$color = '#FFDDDD' if (! defined($color));
foreach my $cell (@rowdata) {	foreach my $cell (@rowdata) {
if ($num_cols_output++ < $num_uneditable) {	if ($num_cols_output++ < $num_uneditable) {
$row_html .= '<td bgcolor="#FFDDDD">';	$row_html .= '<td bgcolor="'.$color.'">';
$row_html .= &html_uneditable_cell($cell,'#FFDDDD');	$row_html .= &html_uneditable_cell($cell,'#FFDDDD');
} else {	} else {
$row_html .= '<td bgcolor="#EOFFDD">';	$row_html .= '<td bgcolor="#EOFFDD">';
Line 1233 sub html_row {	Line 1340 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 => '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 1280 sub excel_output_row {	Line 1399 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) = @_;
$r->print("<h2>Preparing Excel Spreadsheet</h2>");	my $connection = $r->connection();
	#
	$r->print($self->html_report_error());
	$r->rflush();
	#
	$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 1322 sub outsheet_excel {	Line 1431 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($worksheet,$cols_output,$rows_output);	$self->excel_rows($connection,$worksheet,$cols_output,$rows_output,
	$format);
#	#
#	#
# Close the excel file	# Close the excel file
Line 1349 sub outsheet_excel {	Line 1460 sub outsheet_excel {
sub outsheet_csv {	sub outsheet_csv {
my $self = shift;	my $self = shift;
my ($r) = @_;	my ($r) = @_;
	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 1372 sub outsheet_csv {	Line 1488 sub outsheet_csv {
}	}
#	#
# Output the body of the spreadsheet	# Output the body of the spreadsheet
$self->csv_rows($file);	$self->csv_rows($connection,$file);
#	#
# 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 1412 sub outsheet_xml {	Line 1528 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 1450 sub parse_sheet {	Line 1570 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 1468 sub clear_spreadsheet_definition_cache {	Line 1587 sub clear_spreadsheet_definition_cache {
undef(%spreadsheets);	undef(%spreadsheets);
}	}

sub load {	sub load_system_default_sheet {
my $self = shift;	my $self = shift;
my $includedir = $Apache::lonnet::perlvar{'lonIncludes'};	my $includedir = $Apache::lonnet::perlvar{'lonIncludes'};
	# load in the default defined spreadsheet
	my $sheetxml='';
	my $fh;
	if ($fh=Apache::File->new($includedir.'/default_'.$self->{'type'})) {
	$sheetxml=join('',<$fh>);
	$fh->close();
	} else {
	# $sheetxml='<field row="0" col="A">"Error"</field>';
	$sheetxml='<field row="0" col="A"></field>';
	}
	$self->filename('default_');
	my ($formulas,undef) = &parse_sheet(\$sheetxml);
	return $formulas;
	}

	sub load {
	my $self = shift;
#	#
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));
#	#
# see if sheet is cached	# see if sheet is cached
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($self->filename())) {	if (! defined($filename)) {
# load in the default defined spreadsheet	$formulas = $self->load_system_default_sheet();
my $sheetxml='';	} elsif($filename =~ /^\/res\/.*\.spreadsheet$/) {
my $fh;
if ($fh=Apache::File->new($includedir.'/default.'.$filename)) {
$sheetxml=join('',<$fh>);
$fh->close();
} else {
# $sheetxml='<field row="0" col="A">"Error"</field>';
$sheetxml='<field row="0" col="A"></field>';
}
($formulas,undef) = &parse_sheet(\$sheetxml);
} elsif($self->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 1507 sub load {	Line 1636 sub load {
.$self->filename().'"</field>';	.$self->filename().'"</field>';
}	}
($formulas,undef) = &parse_sheet(\$sheetxml);	($formulas,undef) = &parse_sheet(\$sheetxml);
	# Get just the filename and set the sheets filename
	my ($newfilename) = ($filename =~ /\/([^\/]*)\.spreadsheet$/);
	if ($self->is_default()) {
	$self->filename($newfilename);
	$self->make_default();
	} else {
	$self->filename($newfilename);
	}
} else {	} else {
# Load the spreadsheet definition file from the save file	# Load the spreadsheet definition file from the save file
my %tmphash = &Apache::lonnet::dump($self->filename(),$cdom,$cnum);	my %tmphash = &Apache::lonnet::dump($filename,$cdom,$cnum);
my ($tmp) = keys(%tmphash);	my ($tmp) = keys(%tmphash);
if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {	if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {
while (my ($cell,$formula) = each(%tmphash)) {	while (my ($cell,$formula) = each(%tmphash)) {
$formulas->{$cell}=$formula;	$formulas->{$cell}=$formula;
}	}
} else {	} else {
# Unable to grab the specified spreadsheet,	$formulas = $self->load_system_default_sheet();
# so we get the default ones instead.
$filename = 'default.'.$stype;
$self->filename($filename);
my $sheetxml;
if (my $fh=Apache::File->new($includedir.'/'.$filename)) {
$sheetxml = join('',<$fh>);
$fh->close();
} else {
$sheetxml='<field row="0" col="A">'.
'"Unable to load spreadsheet"</field>';
}
($formulas,undef) = &parse_sheet(\$sheetxml);
$self->formulas($formulas);
}	}
}	}
$cachekey = join('_',($cnum,$cdom,$stype,$filename));	$self->formulas($formulas);
%{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas};	$self->set_row_sources();
	$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 > 0);	next if ($cell !~ /^A(\d+)/ \|\| $1 < 1);
my $row = $1;	my $row = $1;
$self->{'row_source'}->{$row} = $value;	$self->{'row_source'}->{$row} = $value;
}	}
return;	return;
}	}

	sub set_row_numbers {
	my $self = shift;
	$self->check_formulas_loaded();
	while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
	next if ($cell !~ /^A(\d+)$/);
	next if (! defined($value));
	$self->{'row_numbers'}->{$value} = $1;
	$self->{'maxrow'} = $1 if ($1 > $self->{'maxrow'});
	}
	}

##	##
## exportrow is not used to get the export row from a computed sub-sheet.	## exportrow is not used to get the export row from a computed sub-sheet.
##	##
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 1573 sub save {	Line 1733 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 $fn = $self->{'filename'};
# Cache new sheet	# Cache new sheet
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%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');
}	}
my $reply = &Apache::lonnet::put($fn,\%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',
{$fn => $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) {
$reply = &Apache::lonnet::put('environment',	$reply = &Apache::lonnet::put('environment',
{'spreadsheet_default_'.$stype => $fn },	{'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()) {
&Apache::lonnet::expirespread('','',$self->{'type'},'');	if ($self->{'type'} eq 'studentcalc') {
	&Apache::lonnet::expirespread('','','studentcalc','');
	} elsif ($self->{'type'} eq 'assesscalc') {
	&Apache::lonnet::expirespread('','','assesscalc','');
	&Apache::lonnet::expirespread('','','studentcalc','');
	}
}	}
return $reply;	return $reply;
}	}
Line 1605 sub save {	Line 1771 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->{'usymb'}.'_'.	$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 1625 sub save_tmp {	Line 1791 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->{'usymb'}.'_'.	$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 othersheets {	Line 1850 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 = sort (keys(%results));	@alternatives = (&mt('Default'), sort (keys(%results)));
}	}
return @alternatives;	return @alternatives;
}	}
Line 1722 sub get_template_row {	Line 1888 sub get_template_row {
return @cols;	return @cols;
}	}

sub set_row_numbers {	sub need_to_save {
my $self = shift;	my $self = shift;
my %f=$self->formulas();	if ($self->{'new_rows'} && ! $self->temporary()) {
while (my ($cell,$value) = each(%{$self->{'formulas'}})) {	return 1;
next if ($cell !~ /^A(\d+)$/);
next if (! defined($value));
$self->{'row_numbers'}->{$value} = $1;
}	}
	return 0;
}	}

sub get_row_number_from_key {	sub get_row_number_from_key {
Line 1741 sub get_row_number_from_key {	Line 1905 sub get_row_number_from_key {
# may not be the key we need to save	# may not be the key we need to save
$self->{'maxrow'}++;	$self->{'maxrow'}++;
$self->{'row_numbers'}->{$key} = $self->{'maxrow'};	$self->{'row_numbers'}->{$key} = $self->{'maxrow'};
	# $self->logthis('added row '.$self->{'row_numbers'}->{$key}.
	# ' for '.$key);
	$self->{'new_rows'} = 1;
}	}
return $self->{'row_numbers'}->{$key};	return $self->{'row_numbers'}->{$key};
}	}

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

Removed from v.1.10
changed lines
	Added in v.1.59