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.2 and 1.43

version 1.2, 2003/05/19 13:58:05	version 1.43, 2005/04/29 18:13:07
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'},	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
	temporary => 0, # true if this sheet has been modified but not saved
	new_rows => 0, # true if this sheet has new rows
	#
	# blackout is used to determine if any data needs to be hidden from the
	# student.
	blackout => 0,
#	#
# Data storage	# Data storage
formulas => {},	formulas => {},
Line 112 sub new {	Line 132 sub new {
#	#
# Load in the spreadsheet definition	# Load in the spreadsheet definition
$self->filename($filename);	$self->filename($filename);
if (exists($ENV{'form.workcopy'}) &&	if (exists($env{'form.workcopy'}) &&
$self->{'type'} eq $ENV{'form.workcopy'}) {	$self->{'type'} eq $env{'form.workcopy'}) {
$self->load_tmp();	$self->load_tmp();
} else {	} else {
$self->load();	$self->load();
Line 137 sub filename {	Line 157 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 !~ /\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) \|\|	if ($newfilename !~ /\w/ \|\| $newfilename =~ /^\W*$/) {
$newfilename !~ /\w/ \|\|	$newfilename = 'default_'.$self->{'type'};
$newfilename =~ /^\W*$/) {	}
$newfilename = 'default.'.$self->{'type'};	if ($newfilename !~ /^default\.$self->{'type'}$/ &&
} else {	$newfilename !~ /^\/res\/(.*)spreadsheet$/) {
my $regexp = '_'.$self->{'type'}.'$';	if ($newfilename !~ /_$self->{'type'}$/) {
if ($newfilename !~ /$regexp/) {	$newfilename =~ s/[\s_]*$//;
$newfilename .= '_'.$self->{'type'};	$newfilename .= '_'.$self->{'type'};
}	}
}	}
Line 179 default spreadsheets.......!	Line 197 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');
my $symb = $self->{'symb'};	my $symb = $self->{'symb'};
Line 212 sub is_default {	Line 230 sub is_default {
if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {	if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {
$default_filename = $tmphash{'spreadsheet_default_'.$self->{'type'}};	$default_filename = $tmphash{'spreadsheet_default_'.$self->{'type'}};
}	}
	if ($default_filename =~ /^\s*$/) {
	$default_filename = '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 223 sub initialize_spreadsheet_package {	Line 259 sub initialize_spreadsheet_package {

sub load_spreadsheet_expirationdates {	sub load_spreadsheet_expirationdates {
undef %expiredates;	undef %expiredates;
my $cid=$ENV{'request.course.id'};	my $cid=$env{'request.course.id'};
my @tmp = &Apache::lonnet::dump('nohist_expirationdates',	my @tmp = &Apache::lonnet::dump('nohist_expirationdates',
$ENV{'course.'.$cid.'.domain'},	$env{'course.'.$cid.'.domain'},
$ENV{'course.'.$cid.'.num'});	$env{'course.'.$cid.'.num'});
if (lc($tmp[0]) !~ /^error/){	if (lc($tmp[0]) !~ /^error/){
%expiredates = @tmp;	%expiredates = @tmp;
}	}
Line 235 sub load_spreadsheet_expirationdates {	Line 271 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 264 Returns the safe space required by a Spr	Line 310 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');
	$safeeval->share('$@');
	my $code=<<'ENDDEFS';
# ---------------------------------------------------- Inside of the safe space	# ---------------------------------------------------- Inside of the safe space
#	#
# f: formulas	# f: formulas
Line 331 $errormsg = '';	Line 385 $errormsg = '';

=pod	=pod

	=item EXT(parameter)

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

	=cut

	#-------------------------------------------------------
	sub EXT {
	my ($parameter) = @_;
	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 340 returns the number of items in the range	Line 413 returns the number of items in the range
#-------------------------------------------------------	#-------------------------------------------------------
sub NUM {	sub NUM {
my $mask=&mask(@_);	my $mask=&mask(@_);
my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1;	my $num= $#{@{grep(eval("/$mask/"),keys(%sheet_values))}}+1;
return $num;	return $num;
}	}

Line 357 sub BIN {	Line 430 sub BIN {
my ($low,$high,$lower,$upper)=@_;	my ($low,$high,$lower,$upper)=@_;
my $mask=&mask($lower,$upper);	my $mask=&mask($lower,$upper);
my $num=0;	my $num=0;
foreach (grep /$mask/,keys(%sheet_values)) {	foreach (grep eval("/$mask/"),keys(%sheet_values)) {
if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {	if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {
$num++;	$num++;
}	}
Line 379 returns the sum of items in the range.	Line 452 returns the sum of items in the range.
sub SUM {	sub SUM {
my $mask=&mask(@_);	my $mask=&mask(@_);
my $sum=0;	my $sum=0;
foreach (grep /$mask/,keys(%sheet_values)) {	foreach (grep eval("/$mask/"),keys(%sheet_values)) {
$sum+=$sheet_values{$_};	$sum+=$sheet_values{$_};
}	}
return $sum;	return $sum;
Line 400 sub MEAN {	Line 473 sub MEAN {
my $mask=&mask(@_);	my $mask=&mask(@_);
my $sum=0;	my $sum=0;
my $num=0;	my $num=0;
foreach (grep /$mask/,keys(%sheet_values)) {	foreach (grep eval("/$mask/"),keys(%sheet_values)) {
$sum+=$sheet_values{$_};	$sum+=$sheet_values{$_};
$num++;	$num++;
}	}
Line 425 compute the standard deviation of the it	Line 498 compute the standard deviation of the it
sub STDDEV {	sub STDDEV {
my $mask=&mask(@_);	my $mask=&mask(@_);
my $sum=0; my $num=0;	my $sum=0; my $num=0;
foreach (grep /$mask/,keys(%sheet_values)) {	foreach (grep eval("/$mask/"),keys(%sheet_values)) {
$sum+=$sheet_values{$_};	$sum+=$sheet_values{$_};
$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 (grep eval("/$mask/"),keys(%sheet_values)) {
$sum+=($sheet_values{$_}-$mean)**2;	$sum+=($sheet_values{$_}-$mean)**2;
}	}
return sqrt($sum/($num-1));	return sqrt($sum/($num-1));
Line 452 compute the product of the items in the	Line 525 compute the product of the items in the
sub PROD {	sub PROD {
my $mask=&mask(@_);	my $mask=&mask(@_);
my $prod=1;	my $prod=1;
foreach (grep /$mask/,keys(%sheet_values)) {	foreach (grep eval("/$mask/"),keys(%sheet_values)) {
$prod*=$sheet_values{$_};	$prod*=$sheet_values{$_};
}	}
return $prod;	return $prod;
Line 472 compute the maximum of the items in the	Line 545 compute the maximum of the items in the
sub MAX {	sub MAX {
my $mask=&mask(@_);	my $mask=&mask(@_);
my $max='-';	my $max='-';
foreach (grep /$mask/,keys(%sheet_values)) {	foreach (grep eval("/$mask/"),keys(%sheet_values)) {
unless ($max) { $max=$sheet_values{$_}; }	unless ($max) { $max=$sheet_values{$_}; }
if (($sheet_values{$_}>$max) \|\| ($max eq '-')) {	if (($sheet_values{$_}>$max) \|\| ($max eq '-')) {
$max=$sheet_values{$_};	$max=$sheet_values{$_};
Line 495 compute the minimum of the items in the	Line 568 compute the minimum of the items in the
sub MIN {	sub MIN {
my $mask=&mask(@_);	my $mask=&mask(@_);
my $min='-';	my $min='-';
foreach (grep /$mask/,keys(%sheet_values)) {	foreach (grep eval("/$mask/"),keys(%sheet_values)) {
unless ($max) { $max=$sheet_values{$_}; }	unless ($max) { $max=$sheet_values{$_}; }
if (($sheet_values{$_}<$min) \|\| ($min eq '-')) {	if (($sheet_values{$_}<$min) \|\| ($min eq '-')) {
$min=$sheet_values{$_};	$min=$sheet_values{$_};
Line 520 sub SUMMAX {	Line 593 sub SUMMAX {
my ($num,$lower,$upper)=@_;	my ($num,$lower,$upper)=@_;
my $mask=&mask($lower,$upper);	my $mask=&mask($lower,$upper);
my @inside=();	my @inside=();
foreach (grep /$mask/,keys(%sheet_values)) {	foreach (grep eval("/$mask/"),keys(%sheet_values)) {
push (@inside,$sheet_values{$_});	push (@inside,$sheet_values{$_});
}	}
@inside=sort(@inside);	@inside=sort {$a <=> $b} (@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 547 sub SUMMIN {	Line 620 sub SUMMIN {
my ($num,$lower,$upper)=@_;	my ($num,$lower,$upper)=@_;
my $mask=&mask($lower,$upper);	my $mask=&mask($lower,$upper);
my @inside=();	my @inside=();
foreach (grep /$mask/,keys(%sheet_values)) {	foreach (grep eval("/$mask/"),keys(%sheet_values)) {
$inside[$#inside+1]=$sheet_values{$_};	$inside[$#inside+1]=$sheet_values{$_};
}	}
@inside=sort(@inside);	@inside=sort {$a <=> $b} (@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 573 parametername should be a string such as	Line 646 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 598 parametername should be a string such as	Line 670 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 637 sub calc {	Line 708 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 chome uhome/) {
$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 669 ENDDEFS	Line 745 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

######################################################	######################################################
{	{
Line 683 sub mask {	Line 770 sub mask {
}	}
$upper = $lower if (! defined($upper));	$upper = $lower if (! defined($upper));
#	#
my ($la,$ld) = ($lower=~/([A-Za-z]\|\)(\d+\|\)/);	my ($la,$ld) = ($lower=~/([A-z]\|\)(\d+\|\)/);
my ($ua,$ud) = ($upper=~/([A-Za-z]\|\)(\d+\|\)/);	my ($ua,$ud) = ($upper=~/([A-z]\|\)(\d+\|\)/);
#	#
my $alpha='';	my $alpha='';
my $num='';	my $num='';
#	#
	# Do not put parenthases around $alpha.
	# $num depends on the value in $1.
if (($la eq '') \|\| ($ua eq '')) {	if (($la eq '') \|\| ($ua eq '')) {
$alpha='[A-Za-z]';	$alpha='[A-z]';
} else {	} else {
if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) \|\|	if ($la gt $ua) {
($la=~/[a-z]/) && ($ua=~/[a-z]/)) {	my $tmp = $ua;
$alpha='['.$la.'-'.$ua.']';	$ua = $la;
} else {	$la = $ua;
$alpha='['.$la.'-Za-'.$ua.']';	}
}	$alpha=qq/[$la-$ua]/;
}	}
if (($ld eq '') \|\| ($ud eq '')) {	if ($ld ne '' && $ud ne '') {
$num='\d+';	# 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 {	} else {
if (length($ld)!=length($ud)) {	$num = '(\d+)';
$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."\$";	my $expression = '^'.$alpha.$num.'$';
$memoizer{$key} = $expression;	$memoizer{$key} = $expression;
return $expression;	return $expression;
}	}

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

}	}

##	##
Line 772 sub expandnamed {	Line 843 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 803 sub expandnamed {	Line 874 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 865 sub sett {	Line 937 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})
	&& $self->{'constants'}->{$cell} ne '') {
my $data = $self->{'constants'}->{$cell};	my $data = $self->{'constants'}->{$cell};
$t{$cell} = $data;	$t{$cell} = $data;
}	}
Line 1097 sub calcsheet {	Line 1170 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
##	##
###########################################################	###########################################################
	sub display {
	my $self = shift;
	my ($r) = @_;
	my $outputmode = 'html';
	foreach ($self->output_options()) {
	if ($env{'form.output_format'} eq $_->{'value'}) {
	$outputmode = $_->{'value'};
	last;
	}
	}
	if ($outputmode eq 'html') {
	$self->compute($r);
	$self->outsheet_html($r);
	} elsif ($outputmode eq 'htmlclasslist') {
	# No computation neccessary... This is kludgy
	$self->outsheet_htmlclasslist($r);
	} elsif ($outputmode eq 'excel') {
	$self->compute($r);
	$self->outsheet_excel($r);
	} elsif ($outputmode eq 'csv') {
	$self->compute($r);
	$self->outsheet_csv($r);
	} elsif ($outputmode eq 'xml') {
	# $self->compute($r);
	$self->outsheet_xml($r);
	}
	$self->cleanup();
	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 1127 sub html_export_row {	Line 1284 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="#DDCCFF">'.	$row_html .= '<td bgcolor="'.$importcolor.'">'.
&html_editable_cell($cell,'#DDCCFF',$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).'</td>';
Line 1164 sub html_editable_cell {	Line 1321 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 1183 sub html_editable_cell {	Line 1344 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 1207 sub html_row {	Line 1373 sub html_row {
return $row_html;	return $row_html;
}	}

sub create_excel_spreadsheet {	sub html_header {
	my $self = shift;
	return '' if (! $env{'request.role.adv'});
	return "<table>\n".
	'<tr><th align="center">'.&mt('Output Format').'</th></tr>'."\n".
	'<tr><td>'.$self->output_selector()."</td></tr>\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 {
	my $self = shift();
	my $output_selector = '<select name="output_format" size="3">'."\n";
	my $default = 'html';
	if (exists($env{'form.output_format'})) {
	$default = $env{'form.output_format'}
	} else {
	$env{'form.output_format'} = $default;
	}
	foreach ($self->output_options()) {
	$output_selector.='<option value="'.$_->{'value'}.'"';
	if ($_->{'value'} eq $default) {
	$output_selector .= ' selected';
	}
	$output_selector .= ">".&mt($_->{'description'})."</option>\n";
	}
	$output_selector .= "</select>\n";
	return $output_selector;
	}

	################################################
	## Excel output routines ##
	################################################
	sub excel_output_row {
	my $self = shift;
	my ($worksheet,$rownum,$rows_output,@prepend) = @_;
	my $cols_output = 0;
	#
	my @rowdata = $self->get_row($rownum);
	foreach my $cell (@prepend,@rowdata) {
	my $value = $cell;
	$value = $cell->{'value'} if (ref($value));
	$value =~ s/\ / /gi;
	$worksheet->write($rows_output,$cols_output++,$value);
	}
	return;
	}

	#
	# This routine is just a stub
	sub outsheet_htmlclasslist {
	my $self = shift;
	my ($r) = @_;
	$r->print('<h2>'.&mt("This output is not supported").'</h2>');
	$r->rflush();
	return;
	}

	sub outsheet_excel {
my $self = shift;	my $self = shift;
my ($r) = @_;	my ($r) = @_;
	my $connection = $r->connection();
	#
	$r->print($self->html_report_error());
	$r->rflush();
	#
	$r->print("<h2>".&mt('Preparing Excel Spreadsheet')."</h2>");
	#
	# Create excel workbook
	my ($workbook,$filename,$format)=&Apache::loncommon::create_workbook($r);
	return if (! defined($workbook));
	#
	# Create main worksheet
	my $worksheet = $workbook->addworksheet('main');
	my $rows_output = 0;
	my $cols_output = 0;
	#
	# Write excel header
	foreach my $value ($self->get_title()) {
	$cols_output = 0;
	$worksheet->write($rows_output++,$cols_output,$value,$format->{'h1'});
	}
	$rows_output++; # skip a line
	#
	# Write summary/export row
	$cols_output = 0;
	$self->excel_output_row($worksheet,0,$rows_output++,'Summary',
	$format->{'b'});
	$rows_output++; # skip a line
	#
	$self->excel_rows($connection,$worksheet,$cols_output,$rows_output,
	$format);
	#
	#
	# Close the excel file
	$workbook->close();
	#
	# Write a link to allow them to download it
	$r->print('<br />'.
	'<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n");
	return;
	}

	#################################
	## CSV output routines ##
	#################################
	sub outsheet_csv {
	my $self = shift;
	my ($r) = @_;
	my $connection = $r->connection();
	#
	$r->print($self->html_report_error());
	$r->rflush();
	#
	my $csvdata = '';
	my @Values;
	#
	# 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).'.xls';	time.'_'.rand(1000000000).'.csv';
my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);	my $file;
if (! defined($workbook)) {	unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) {
$r->log_error("Error creating excel spreadsheet $filename: $!");	$r->log_error("Couldn't open $filename for output $!");
$r->print("Problems creating new Excel 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."));
return undef;	$r->print("<pre>\n".$csvdata."</pre>\n");
	return 0;
	}
	#
	# Output the title information
	foreach my $value ($self->get_title()) {
	print $file "'".&Apache::loncommon::csv_translate($value)."'\n";
}	}
#	#
# The excel spreadsheet stores temporary data in files, then put them	# Output the body of the spreadsheet
# together. If needed we should be able to disable this (memory only).	$self->csv_rows($connection,$file);
# The temporary directory must be specified before calling 'addworksheet'.	#
# File::Temp is used to determine the temporary directory.	# Close the csv file
$workbook->set_tempdir('/home/httpd/perl/tmp');	close($file);
	$r->print('<br /><br />'.
	'<a href="'.$filename.'">'.&mt('Your CSV spreadsheet.').'</a>'."\n");
	#
	return 1;
	}

	sub csv_output_row {
	my $self = shift;
	my ($filehandle,$rownum,@prepend) = @_;
#	#
# Determine the name to give the worksheet	my @rowdata = ();
return ($workbook,$filename);	if (defined($rownum)) {
	@rowdata = $self->get_row($rownum);
	}
	my @output = ();
	foreach my $cell (@prepend,@rowdata) {
	my $value = $cell;
	$value = $cell->{'value'} if (ref($value));
	$value =~ s/\ / /gi;
	$value = "'".$value."'";
	push (@output,$value);
	}
	print $filehandle join(',',@output )."\n";
	return;
}	}

############################################	############################################
Line 1243 sub outsheet_xml {	Line 1564 sub outsheet_xml {
## But not on this day	## But not on this day
my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n";	my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n";
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 1280 sub parse_sheet {	Line 1604 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 1298 sub clear_spreadsheet_definition_cache {	Line 1621 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 $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
Line 1316 sub load {	Line 1656 sub load {
$formulas = $spreadsheets{$cachekey}->{'formulas'};	$formulas = $spreadsheets{$cachekey}->{'formulas'};
} 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() =~ /^\/*\.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 1337 sub load {	Line 1667 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);
}	}
}	}
	$filename=$self->filename(); # filename may have changed
$cachekey = join('_',($cnum,$cdom,$stype,$filename));	$cachekey = join('_',($cnum,$cdom,$stype,$filename));
%{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas};	%{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas};
}	}
Line 1373 sub load {	Line 1699 sub load {
sub set_row_sources {	sub set_row_sources {
my $self = shift;	my $self = shift;
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;
	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 1396 sub save {	Line 1735 sub save {
my $self = shift;	my $self = shift;
my ($makedef)=@_;	my ($makedef)=@_;
my $cid=$self->{'cid'};	my $cid=$self->{'cid'};
	# If we are saving it, it must not be temporary
	$self->temporary(0);
if (&Apache::lonnet::allowed('opa',$cid)) {	if (&Apache::lonnet::allowed('opa',$cid)) {
my %f=$self->formulas();	my %f=$self->formulas();
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 $chome = $self->{'chome'};
my $fn = $self->{'filename'};	my $filename = $self->{'filename'};
	my $cachekey = join('_',($cnum,$cdom,$stype,$filename));
# Cache new sheet	# Cache new sheet
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);	%{$spreadsheets{$cachekey}->{'formulas'}}=%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');
}	}
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 1433 sub save {	Line 1780 sub save {

sub save_tmp {	sub save_tmp {
my $self = shift;	my $self = shift;
my $fn=$ENV{'user.name'}.'_'.	my $filename=$env{'user.name'}.'_'.
$ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'.	$env{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.
$self->{'filename'};	$self->{'filename'};
$fn=~s/\W/\_/g;	$filename=~s/\W/\_/g;
$fn=$Apache::lonnet::tmpdir.$fn.'.tmp';	$filename=$Apache::lonnet::tmpdir.$filename.'.tmp';
	$self->temporary(1);
my $fh;	my $fh;
if ($fh=Apache::File->new('>'.$fn)) {	if ($fh=Apache::File->new('>'.$filename)) {
my %f = $self->formulas();	my %f = $self->formulas();
while( my ($cell,$formula) = each(%f)) {	while( my ($cell,$formula) = each(%f)) {
next if ($formula eq 'import');	next if ($formula eq 'import');
Line 1452 sub save_tmp {	Line 1800 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 1468 sub load_tmp {	Line 1816 sub load_tmp {
}	}
$spreadsheet_file->close();	$spreadsheet_file->close();
}	}
	# flag the sheet as temporary
	$self->temporary(1);
$self->formulas(\%formulas);	$self->formulas(\%formulas);
$self->set_row_sources();	$self->set_row_sources();
$self->set_row_numbers();	$self->set_row_numbers();
return;	return;
}	}

	sub temporary {
	my $self=shift;
	if (@_) {
	($self->{'temporary'})= @_;
	}
	return $self->{'temporary'};
	}

sub modify_cell {	sub modify_cell {
# studentcalc overrides this	# studentcalc overrides this
my $self = shift;	my $self = shift;
Line 1501 sub othersheets {	Line 1859 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;
}	}

	sub blackout {
	my $self = shift;
	$self->{'blackout'} = $_[0] if (@_);
	return $self->{'blackout'};
	}

sub get_row {	sub get_row {
my $self = shift;	my $self = shift;
my ($n)=@_;	my ($n)=@_;
Line 1533 sub get_template_row {	Line 1897 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 1552 sub get_row_number_from_key {	Line 1914 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.2
changed lines
	Added in v.1.43