|
version 1.41, 2005/04/07 06:56:23
|
version 1.87, 2025/01/04 23:38:38
|
|
Line 60 use HTML::TokeParser;
|
Line 60 use HTML::TokeParser;
|
| use Spreadsheet::WriteExcel; |
use Spreadsheet::WriteExcel; |
| use Time::HiRes; |
use Time::HiRes; |
| use Apache::lonlocal; |
use Apache::lonlocal; |
| |
use lib '/home/httpd/lib/perl/'; |
| |
use LONCAPA; |
| |
|
| |
|
| ## |
## |
| ## Package Variables |
## Package Variables |
|
Line 85 sub new {
|
Line 88 sub new {
|
| my $class = ref($this) || $this; |
my $class = ref($this) || $this; |
| my ($stype) = ($class =~ /Apache::(.*)$/); |
my ($stype) = ($class =~ /Apache::(.*)$/); |
| # |
# |
| my ($name,$domain,$filename,$usymb)=@_; |
my ($name,$domain,$filename,$usymb,$section,$groups)=@_; |
| if (defined($usymb) && ref($usymb)) { |
if (defined($usymb) && ref($usymb)) { |
| $usymb = $usymb->symb; |
$usymb = $usymb->symb; |
| } |
} |
|
Line 95 sub new {
|
Line 98 sub new {
|
| if (! defined($domain) || $domain eq '') { |
if (! defined($domain) || $domain eq '') { |
| $domain = $env{'user.domain'}; |
$domain = $env{'user.domain'}; |
| } |
} |
| |
if (! defined($section) || $section eq '') { |
| |
$section = &Apache::lonnet::getsection($domain,$name, |
| |
$env{'request.course.id'}); |
| |
} |
| |
if (! defined($groups)) { |
| |
|
| |
my @usersgroups = &Apache::lonnet::get_users_groups($domain,$name, |
| |
$env{'request.course.id'}); |
| |
$groups = \@usersgroups; |
| |
} |
| # |
# |
| my $self = { |
my $self = { |
| name => $name, |
name => $name, |
| domain => $domain, |
domain => $domain, |
| |
section => $section, |
| |
groups => $groups, |
| type => $stype, |
type => $stype, |
| symb => $usymb, |
symb => $usymb, |
| errorlog => '', |
errorlog => '', |
|
Line 106 sub new {
|
Line 121 sub new {
|
| cid => $env{'request.course.id'}, |
cid => $env{'request.course.id'}, |
| cnum => $env{'course.'.$env{'request.course.id'}.'.num'}, |
cnum => $env{'course.'.$env{'request.course.id'}.'.num'}, |
| cdom => $env{'course.'.$env{'request.course.id'}.'.domain'}, |
cdom => $env{'course.'.$env{'request.course.id'}.'.domain'}, |
| chome => $env{'course.'.$env{'request.course.id'}.'.home'}, |
|
| coursedesc => $env{'course.'.$env{'request.course.id'}.'.description'}, |
coursedesc => $env{'course.'.$env{'request.course.id'}.'.description'}, |
| coursefilename => $env{'request.course.fn'}, |
coursefilename => $env{'request.course.fn'}, |
| # |
# |
| # Flags |
# Flags |
| temporary => 0, # true if this sheet has been modified but not saved |
temporary => 0, # true if this sheet has been modified but not saved |
| new_rows => 0, # true if this sheet has new rows |
new_rows => 0, # true if this sheet has new rows |
| |
loaded => 0, # true if the formulas have been loaded |
| # |
# |
| # blackout is used to determine if any data needs to be hidden from the |
# blackout is used to determine if any data needs to be hidden from the |
| # student. |
# student. |
|
Line 126 sub new {
|
Line 141 sub new {
|
| othersheets => [], |
othersheets => [], |
| }; |
}; |
| # |
# |
| $self->{'uhome'} = &Apache::lonnet::homeserver($name,$domain); |
|
| # |
|
| bless($self,$class); |
bless($self,$class); |
| # |
|
| # Load in the spreadsheet definition |
|
| $self->filename($filename); |
$self->filename($filename); |
| if (exists($env{'form.workcopy'}) && |
# |
| $self->{'type'} eq $env{'form.workcopy'}) { |
|
| $self->load_tmp(); |
|
| } else { |
|
| $self->load(); |
|
| } |
|
| return $self; |
return $self; |
| } |
} |
| |
|
|
Line 166 sub filename {
|
Line 172 sub filename {
|
| $newfilename = 'default_'.$self->{'type'}; |
$newfilename = 'default_'.$self->{'type'}; |
| } |
} |
| } |
} |
| if ($newfilename !~ /\w/ || $newfilename =~ /^\W*$/) { |
if ($newfilename eq &mt('LON-CAPA Standard')) { |
| $newfilename = 'default_'.$self->{'type'}; |
undef($newfilename); |
| } |
} else { |
| if ($newfilename !~ /^default\.$self->{'type'}$/ && |
if ($newfilename !~ /\w/ || $newfilename =~ /^\W*$/) { |
| $newfilename !~ /^\/res\/(.*)spreadsheet$/) { |
$newfilename = 'default_'.$self->{'type'}; |
| if ($newfilename !~ /_$self->{'type'}$/) { |
} |
| $newfilename =~ s/[\s_]*$//; |
if ($newfilename !~ /^default\.$self->{'type'}$/ && |
| $newfilename .= '_'.$self->{'type'}; |
$newfilename !~ /^\/res\/(.*)spreadsheet$/) { |
| } |
if ($newfilename !~ /_$self->{'type'}$/) { |
| } |
$newfilename =~ s/[\s_]*$//; |
| |
$newfilename .= '_'.$self->{'type'}; |
| |
} |
| |
} |
| |
} |
| $self->{'filename'} = $newfilename; |
$self->{'filename'} = $newfilename; |
| return; |
return; |
| } |
} |
|
Line 200 sub make_default {
|
Line 210 sub make_default {
|
| {'spreadsheet_default_'.$self->{'type'} => $self->filename()}, |
{'spreadsheet_default_'.$self->{'type'} => $self->filename()}, |
| $self->{'cdom'},$self->{'cnum'}); |
$self->{'cdom'},$self->{'cnum'}); |
| return $result if ($result ne 'ok'); |
return $result if ($result ne 'ok'); |
| |
&Apache::lonnet::appenv({'course.'.$self->{'cid'}.'.spreadsheet_default_'. |
| |
$self->{'type'} => $self->filename()}); |
| my $symb = $self->{'symb'}; |
my $symb = $self->{'symb'}; |
| $symb = '' if (! defined($symb)); |
$symb = '' if (! defined($symb)); |
| &Apache::lonnet::expirespread('','',$self->{'type'},$symb); |
&Apache::lonnet::expirespread('','',$self->{'type'},$symb); |
|
Line 220 course environment. Returns 0 otherwise
|
Line 232 course environment. Returns 0 otherwise
|
| sub is_default { |
sub is_default { |
| my $self = shift; |
my $self = shift; |
| # Check to find out if we are the default spreadsheet (filenames match) |
# Check to find out if we are the default spreadsheet (filenames match) |
| my $default_filename = ''; |
my $default_filename = $env{'course.'.$self->{'cid'}. |
| my %tmphash = &Apache::lonnet::get('environment', |
'.spreadsheet_default_'.$self->{'type'}}; |
| ['spreadsheet_default_'. |
|
| $self->{'type'}], |
|
| $self->{'cdom'}, |
|
| $self->{'cnum'}); |
|
| my ($tmp) = keys(%tmphash); |
|
| if ($tmp !~ /^(con_lost|error|no_such_host)/i) { |
|
| $default_filename = $tmphash{'spreadsheet_default_'.$self->{'type'}}; |
|
| } |
|
| if ($default_filename =~ /^\s*$/) { |
if ($default_filename =~ /^\s*$/) { |
| $default_filename = 'default_'.$self->{'type'}; |
$default_filename = 'default_'.$self->{'type'}; |
| } |
} |
|
Line 323 sub initialize_safe_space {
|
Line 327 sub initialize_safe_space {
|
| $safeeval = new Safe(shift); |
$safeeval = new Safe(shift); |
| my $safehole = new Safe::Hole; |
my $safehole = new Safe::Hole; |
| $safeeval->permit("entereval"); |
$safeeval->permit("entereval"); |
| |
$safeeval->permit("hintseval"); |
| $safeeval->permit(":base_math"); |
$safeeval->permit(":base_math"); |
| $safeeval->permit("sort"); |
$safeeval->permit("sort"); |
| $safeeval->deny(":base_io"); |
$safeeval->deny(":base_io"); |
| $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&Apache::lonnet::EXT'); |
$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&Apache::lonnet::EXT'); |
| $safehole->wrap(\&mask,$safeeval,'&mask'); |
$safehole->wrap(\&mask,$safeeval,'&mask'); |
| |
$safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&logthis'); |
| $safeeval->share('$@'); |
$safeeval->share('$@'); |
| |
# Holds the (computed, final) values for the sheet |
| |
# This is only written to by &calc, the spreadsheet computation routine. |
| |
# It is read by many functions |
| |
$safeeval->share('%sheet_values'); |
| my $code=<<'ENDDEFS'; |
my $code=<<'ENDDEFS'; |
| # ---------------------------------------------------- Inside of the safe space |
# ---------------------------------------------------- Inside of the safe space |
| # |
# |
|
Line 338 sub initialize_safe_space {
|
Line 348 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 364 $filename = '';
|
Line 371 $filename = '';
|
| # |
# |
| # user data |
# user data |
| $name = ''; |
$name = ''; |
| $uhome = ''; |
|
| $domain = ''; |
$domain = ''; |
| # |
# |
| # course data |
# course data |
| $csec = ''; |
$csec = ''; |
| $chome= ''; |
|
| $cnum = ''; |
$cnum = ''; |
| $cdom = ''; |
$cdom = ''; |
| $cid = ''; |
$cid = ''; |
|
Line 393 Calls the system EXT function to determi
|
Line 398 Calls the system EXT function to determi
|
| |
|
| #------------------------------------------------------- |
#------------------------------------------------------- |
| sub EXT { |
sub EXT { |
| my ($parameter) = @_; |
my ($parameter,$specific_symb) = @_; |
| return '' if (! defined($parameter) || $parameter eq ''); |
return '' if (! defined($parameter) || $parameter eq ''); |
| $parameter =~ s/^parameter\./resource\./; |
$parameter =~ s/^parameter\./resource\./; |
| my $value = &Apache::lonnet::EXT($parameter,$symb,$domain,$name,$usection); |
if ($specific_symb eq '') { $specific_symb = $symb; } |
| |
my $value = &Apache::lonnet::EXT($parameter,$specific_symb,$domain,$name, |
| |
$usection); |
| return $value; |
return $value; |
| } |
} |
| |
|
|
Line 412 returns the number of items in the range
|
Line 419 returns the number of items in the range
|
| |
|
| #------------------------------------------------------- |
#------------------------------------------------------- |
| sub NUM { |
sub NUM { |
| my $mask=&mask(@_); |
my $values=&get_values(@_); |
| my $num= $#{@{grep(eval("/$mask/"),keys(%sheet_values))}}+1; |
my $num= scalar(@$values); |
| return $num; |
return $num; |
| } |
} |
| |
|
|
Line 428 sub NUM {
|
Line 435 sub NUM {
|
| #------------------------------------------------------- |
#------------------------------------------------------- |
| sub BIN { |
sub BIN { |
| my ($low,$high,$lower,$upper)=@_; |
my ($low,$high,$lower,$upper)=@_; |
| my $mask=&mask($lower,$upper); |
my $values=&get_values($lower,$upper); |
| my $num=0; |
my $num=0; |
| foreach (grep eval("/$mask/"),keys(%sheet_values)) { |
foreach (@$values) { |
| if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) { |
if (($_>=$low) && ($_<=$high)) { |
| $num++; |
$num++; |
| } |
} |
| } |
} |
|
Line 450 returns the sum of items in the range.
|
Line 457 returns the sum of items in the range.
|
| |
|
| #------------------------------------------------------- |
#------------------------------------------------------- |
| sub SUM { |
sub SUM { |
| my $mask=&mask(@_); |
my $values=&get_values(@_); |
| my $sum=0; |
my $sum=0; |
| foreach (grep eval("/$mask/"),keys(%sheet_values)) { |
foreach (@$values) { |
| $sum+=$sheet_values{$_}; |
$sum+=$_; |
| } |
} |
| return $sum; |
return $sum; |
| } |
} |
|
Line 470 compute the average of the items in the
|
Line 477 compute the average of the items in the
|
| |
|
| #------------------------------------------------------- |
#------------------------------------------------------- |
| sub MEAN { |
sub MEAN { |
| my $mask=&mask(@_); |
my $values=&get_values(@_); |
| my $sum=0; |
my $sum=0; |
| my $num=0; |
my $num=0; |
| foreach (grep eval("/$mask/"),keys(%sheet_values)) { |
foreach (@$values) { |
| $sum+=$sheet_values{$_}; |
$sum+=$_; |
| $num++; |
$num++; |
| } |
} |
| if ($num) { |
if ($num) { |
|
Line 496 compute the standard deviation of the it
|
Line 503 compute the standard deviation of the it
|
| |
|
| #------------------------------------------------------- |
#------------------------------------------------------- |
| sub STDDEV { |
sub STDDEV { |
| my $mask=&mask(@_); |
my $values=&get_values(@_); |
| my $sum=0; my $num=0; |
my $sum=0; my $num=0; |
| foreach (grep eval("/$mask/"),keys(%sheet_values)) { |
foreach (@$values) { |
| $sum+=$sheet_values{$_}; |
$sum+=$_; |
| $num++; |
$num++; |
| } |
} |
| unless ($num>1) { return undef; } |
unless ($num>1) { return undef; } |
| my $mean=$sum/$num; |
my $mean=$sum/$num; |
| $sum=0; |
$sum=0; |
| foreach (grep eval("/$mask/"),keys(%sheet_values)) { |
foreach (@$values) { |
| $sum+=($sheet_values{$_}-$mean)**2; |
$sum+=($_-$mean)**2; |
| } |
} |
| return sqrt($sum/($num-1)); |
return sqrt($sum/($num-1)); |
| } |
} |
|
Line 523 compute the product of the items in the
|
Line 530 compute the product of the items in the
|
| |
|
| #------------------------------------------------------- |
#------------------------------------------------------- |
| sub PROD { |
sub PROD { |
| my $mask=&mask(@_); |
my $values=&get_values(@_); |
| my $prod=1; |
my $prod=1; |
| foreach (grep eval("/$mask/"),keys(%sheet_values)) { |
foreach (@$values) { |
| $prod*=$sheet_values{$_}; |
$prod*=$_; |
| } |
} |
| return $prod; |
return $prod; |
| } |
} |
|
Line 543 compute the maximum of the items in the
|
Line 550 compute the maximum of the items in the
|
| |
|
| #------------------------------------------------------- |
#------------------------------------------------------- |
| sub MAX { |
sub MAX { |
| my $mask=&mask(@_); |
my $values=&get_values(@_); |
| my $max='-'; |
my $max='-'; |
| foreach (grep eval("/$mask/"),keys(%sheet_values)) { |
foreach (@$values) { |
| unless ($max) { $max=$sheet_values{$_}; } |
if (($_>$max) || ($max eq '-')) { |
| if (($sheet_values{$_}>$max) || ($max eq '-')) { |
$max=$_; |
| $max=$sheet_values{$_}; |
|
| } |
} |
| } |
} |
| return $max; |
return $max; |
|
Line 566 compute the minimum of the items in the
|
Line 572 compute the minimum of the items in the
|
| |
|
| #------------------------------------------------------- |
#------------------------------------------------------- |
| sub MIN { |
sub MIN { |
| my $mask=&mask(@_); |
my $values=&get_values(@_); |
| my $min='-'; |
my $min='-'; |
| foreach (grep eval("/$mask/"),keys(%sheet_values)) { |
foreach (@$values) { |
| unless ($max) { $max=$sheet_values{$_}; } |
if (($_<$min) || ($min eq '-')) { |
| if (($sheet_values{$_}<$min) || ($min eq '-')) { |
$min=$_; |
| $min=$sheet_values{$_}; |
|
| } |
} |
| } |
} |
| return $min; |
return $min; |
|
Line 591 compute the sum of the largest 'num' ite
|
Line 596 compute the sum of the largest 'num' ite
|
| #------------------------------------------------------- |
#------------------------------------------------------- |
| sub SUMMAX { |
sub SUMMAX { |
| my ($num,$lower,$upper)=@_; |
my ($num,$lower,$upper)=@_; |
| my $mask=&mask($lower,$upper); |
my $values=&get_values($lower,$upper); |
| my @inside=(); |
my @inside=sort {$a <=> $b} (@$values); |
| foreach (grep eval("/$mask/"),keys(%sheet_values)) { |
|
| push (@inside,$sheet_values{$_}); |
|
| } |
|
| @inside=sort(@inside); |
|
| my $sum=0; my $i; |
my $sum=0; my $i; |
| for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { |
for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { |
| $sum+=$inside[$i]; |
$sum+=$inside[$i]; |
|
Line 618 compute the sum of the smallest 'num' it
|
Line 619 compute the sum of the smallest 'num' it
|
| #------------------------------------------------------- |
#------------------------------------------------------- |
| sub SUMMIN { |
sub SUMMIN { |
| my ($num,$lower,$upper)=@_; |
my ($num,$lower,$upper)=@_; |
| my $mask=&mask($lower,$upper); |
my $values=&get_values($lower,$upper); |
| my @inside=(); |
my @inside=sort {$a <=> $b} (@$values); |
| foreach (grep eval("/$mask/"),keys(%sheet_values)) { |
|
| $inside[$#inside+1]=$sheet_values{$_}; |
|
| } |
|
| @inside=sort(@inside); |
|
| my $sum=0; my $i; |
my $sum=0; my $i; |
| for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { |
for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { |
| $sum+=$inside[$i]; |
$sum+=$inside[$i]; |
|
Line 680 sub MAXPARM {
|
Line 677 sub MAXPARM {
|
| } |
} |
| |
|
| |
|
| |
=pod |
| |
|
| |
=item PARM(parametername) |
| |
|
| |
Returns the value of the parameter matching the input parameter name. |
| |
parametername should be a string such as 'parameter_1_opendate'. |
| |
|
| |
=cut |
| |
|
| |
#------------------------------------------------------- |
| |
sub PARM { |
| |
return $c{$_[0]}; |
| |
} |
| |
|
| |
#------------------------------------------------------- |
| |
|
| |
=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})) && ($sheet_values{$a.$n} ne '')) { |
| |
push(@values,$sheet_values{$a.$n}); |
| |
} |
| |
} |
| |
} |
| |
return \@values; |
| |
} else { |
| |
$num = '([1-9]\d*)'; |
| |
} |
| |
if (($la eq '*') || ($ua eq '*')) { |
| |
$alpha='[A-z]'; |
| |
} else { |
| |
if ($la gt $ua) { ($la,$ua)=($ua,$la); } |
| |
$alpha=qq/[$la-$ua]/; |
| |
} |
| |
my $expression = '^'.$alpha.$num.'$'; |
| |
foreach my $item (grep(/$expression/,keys(%sheet_values))) { |
| |
unless ($sheet_values{$item} eq '') { |
| |
push(@values,$sheet_values{$item}); |
| |
} |
| |
} |
| |
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 705 sub calc {
|
Line 775 sub calc {
|
| $depth++; |
$depth++; |
| if ($depth>100) { |
if ($depth>100) { |
| undef %sheet_values; |
undef %sheet_values; |
| return $lastcalc.': Maximum calculation depth exceeded'; |
return $lastcalc.': '.&mt('Maximum calculation depth exceeded'); |
| } |
} |
| } |
} |
| return 'okay'; |
return 'okay'; |
|
Line 722 ENDDEFS
|
Line 792 ENDDEFS
|
| # itself |
# itself |
| my $initstring = ''; |
my $initstring = ''; |
| foreach (qw/name domain type symb 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";}; |
$initstring.=qq{\$usection="$usection";}; |
|
Line 742 ENDDEFS
|
Line 812 ENDDEFS
|
| |
|
| ###################################################### |
###################################################### |
| |
|
| |
|
| ###################################################### |
|
| |
|
| =pod |
|
| |
|
| =item &mask($lower,$upper) |
|
| |
|
| Inputs: $lower and $upper, cell names ("X12" or "a150") or globs ("X*"). |
|
| |
|
| Returns: Regular expression matching spreadsheet cells that are within |
|
| the rectangle defined by $lower and $upper. Due to the nature of the |
|
| regular expression this result must be used inside an eval(). |
|
| |
|
| =cut |
|
| |
|
| ###################################################### |
|
| { |
|
| |
|
| my %memoizer; |
|
| |
|
| sub mask { |
|
| my ($lower,$upper)=@_; |
|
| my $key = $lower.'_'.$upper; |
|
| if (exists($memoizer{$key})) { |
|
| return $memoizer{$key}; |
|
| } |
|
| $upper = $lower if (! defined($upper)); |
|
| # |
|
| my ($la,$ld) = ($lower=~/([A-z]|\*)(\d+|\*)/); |
|
| my ($ua,$ud) = ($upper=~/([A-z]|\*)(\d+|\*)/); |
|
| # |
|
| my $alpha=''; |
|
| my $num=''; |
|
| # |
|
| # Do not put parenthases around $alpha. |
|
| # $num depends on the value in $1. |
|
| if (($la eq '*') || ($ua eq '*')) { |
|
| $alpha='[A-z]'; |
|
| } else { |
|
| if ($la gt $ua) { |
|
| my $tmp = $ua; |
|
| $ua = $la; |
|
| $la = $ua; |
|
| } |
|
| $alpha=qq/[$la-$ua]/; |
|
| } |
|
| if ($ld ne '*' && $ud ne '*') { |
|
| # Make sure $ld <= $ud |
|
| if ($ld > $ud) { |
|
| my $tmp = $ud; |
|
| $ud = $ld; |
|
| $ld = $tmp; |
|
| } |
|
| # Here we make a regular expression using some advanced regexp |
|
| # abilities. |
|
| # (\d+) will match the digits of the cell name and dump them in |
|
| # to $1 |
|
| # (?(?{ ... code ...} pattern_if_true | pattern_if_false)) will |
|
| # choose pattern_if_true if { ... code ... } is true and |
|
| # pattern_if_false if { ... code ... } is false. |
|
| # In this case, pattern_if_true is empty. pattern_if_false is |
|
| # 'donotmatch' and will not match our cells because none of |
|
| # them end with donotmatch. |
|
| # Unfortunately, the use of this type of regular expression |
|
| # requires that each match be wrapped in an eval(). Search for |
|
| # $mask in this module for examples |
|
| $num = '(\d+)(?(?{$1>= '.$ld.' && $1<='.$ud.'})|donotmatch)'; |
|
| } else { |
|
| $num = '(\d+)'; |
|
| } |
|
| my $expression = '^'.$alpha.$num.'$'; |
|
| $memoizer{$key} = $expression; |
|
| return $expression; |
|
| } |
|
| |
|
| # |
|
| # Debugging routine |
|
| sub dump_memoized_values { |
|
| while (my ($key,$value) = each(%memoizer)) { |
|
| &Apache::lonnet::logthis('memoizer: '.$key.' = '.$value); |
|
| } |
|
| return; |
|
| } |
|
| |
|
| } |
|
| |
|
| ## |
## |
| ## sub add_hash_to_safe {} # spreadsheet, would like to destroy |
## sub add_hash_to_safe {} # spreadsheet, would like to destroy |
| ## |
## |
|
Line 839 sub expandnamed {
|
Line 823 sub expandnamed {
|
| my $self = shift; |
my $self = shift; |
| my $expression=shift; |
my $expression=shift; |
| if ($expression=~/^\&/) { |
if ($expression=~/^\&/) { |
| my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/); |
my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/s); |
| my @vars=split(/\W+/,$formula); |
my @vars=split(/\W+/,$formula); |
| |
# make the list uniq |
| |
@vars = keys(%{{ map { $_ => 1 } @vars }}); |
| my %values=(); |
my %values=(); |
| foreach my $varname ( @vars ) { |
foreach my $varname ( @vars ) { |
| if ($varname=~/^(parameter|stores|timestamp)/) { |
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/) { |
| $values{$1}=1; |
$values{$1}=1; |
| } |
} |
| } |
} |
| } |
} |
| } |
} |
| if ($func eq 'EXPANDSUM') { |
if ($func eq 'EXPANDSUM') { |
|
Line 861 sub expandnamed {
|
Line 847 sub expandnamed {
|
| $result.=$thissum.'+'; |
$result.=$thissum.'+'; |
| } |
} |
| $result=~s/\+$//; |
$result=~s/\+$//; |
| return $result; |
return '('.$result.')'; |
| } else { |
} else { |
| return 0; |
return 0; |
| } |
} |
|
Line 888 sub expandnamed {
|
Line 874 sub expandnamed {
|
| $returnvalue = $values[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 = "'".&mt('non-unique parameter name: [_1]',$expression).'"'; |
| for (my $i=0; $i<=$#matches;$i++) { |
for (my $i=0; $i<=$#matches;$i++) { |
| if ($matches[$i] =~ /^$expression$/) { |
if ($matches[$i] =~ /^$expression$/) { |
| # why do we not do this lookup here? |
# why do we not do this lookup here? |
|
Line 898 sub expandnamed {
|
Line 884 sub expandnamed {
|
| } 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: '.$expression.'"'; |
$returnvalue = "'".&mt('bizarre parameter: [_1]',$expression)."'"; |
| } |
} |
| return $returnvalue; |
return $returnvalue; |
| } |
} |
|
Line 907 sub expandnamed {
|
Line 893 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 923 sub sett {
|
Line 910 sub sett {
|
| # Replace 'A0' with the value from 'A0' |
# Replace 'A0' with the value from 'A0' |
| $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; |
$t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; |
| # Replace parameters |
# Replace parameters |
| $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; |
$t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/sge; |
| } |
} |
| } |
} |
| # |
# |
|
Line 935 sub sett {
|
Line 922 sub sett {
|
| $t{$cell}=$formula; |
$t{$cell}=$formula; |
| $t{$cell}=~s/\.\.+/\,/g; |
$t{$cell}=~s/\.\.+/\,/g; |
| $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)/sge; |
| } 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; |
| $t{$cell}=~s/\.\.+/\,/g; |
$t{$cell}=~s/\.\.+/\,/g; |
| $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)/sge; |
| } |
} |
| } |
} |
| %{$self->{'safe'}->varglob('t')}=%t; |
%{$self->{'safe'}->varglob('t')}=%t; |
|
Line 958 sub sett {
|
Line 946 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 1015 sub formulas {
|
Line 1003 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 1033 sub set_formula {
|
Line 1038 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 1044 sub formulas_keys {
|
Line 1049 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 1122 sub rebuild_stats {
|
Line 1128 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 1227 sub display {
|
Line 1234 sub display {
|
| last; |
last; |
| } |
} |
| } |
} |
| |
$self->{outputmode} = $outputmode; |
| if ($outputmode eq 'html') { |
if ($outputmode eq 'html') { |
| $self->compute($r); |
$self->compute($r); |
| $self->outsheet_html($r); |
$self->outsheet_html($r); |
| } elsif ($outputmode eq 'htmlclasslist') { |
} elsif ($outputmode eq 'htmlclasslist') { |
| # No computation neccessary... This is kludgy |
# No computation neccessary... This is kludgy |
| $self->outsheet_htmlclasslist($r); |
$self->outsheet_htmlclasslist($r); |
| |
} elsif ($outputmode eq 'source') { |
| |
# No computation necessary. Rumor has it that this is some |
| |
# sort of kludge w.r.t. not "computing". It's also |
| |
# a bit of of a kludge that we call "outsheet_html" and |
| |
# let the 'outputmode' cause the outputting of source. |
| |
$self->outsheet_html($r); |
| } elsif ($outputmode eq 'excel') { |
} elsif ($outputmode eq 'excel') { |
| $self->compute($r); |
$self->compute($r); |
| $self->outsheet_excel($r); |
$self->outsheet_excel($r); |
|
Line 1254 sub html_report_error {
|
Line 1268 sub html_report_error {
|
| my $self = shift(); |
my $self = shift(); |
| my $Str = ''; |
my $Str = ''; |
| if ($self->badcalc()) { |
if ($self->badcalc()) { |
| $Str = '<h3 style="color:red">'. |
$Str = '<p class="LC_error">'. |
| &mt('An error occurred while calculating this spreadsheet'). |
&mt('An error occurred while calculating this spreadsheet'). |
| "</h3>\n". |
"</p>\n". |
| '<pre>'.$self->calcerror()."</pre>\n"; |
'<pre>'.$self->calcerror()."</pre>\n"; |
| } |
} |
| return $Str; |
return $Str; |
|
Line 1272 sub html_export_row {
|
Line 1286 sub html_export_row {
|
| foreach my $cell (@rowdata) { |
foreach my $cell (@rowdata) { |
| if ($cell->{'name'} =~ /^[A-Z]/) { |
if ($cell->{'name'} =~ /^[A-Z]/) { |
| $row_html .= '<td bgcolor="'.$color.'">'. |
$row_html .= '<td bgcolor="'.$color.'">'. |
| &html_editable_cell($cell,$color,$allowed).'</td>'; |
&html_editable_cell($cell,$color,$allowed, |
| |
$self->{outputmode} eq 'source').'</td>'; |
| } else { |
} else { |
| $row_html .= '<td bgcolor="#DDCCFF">'. |
$row_html .= '<td bgcolor="#DDCCFF">'. |
| &html_editable_cell($cell,'#DDCCFF',$allowed).'</td>'; |
&html_editable_cell($cell,'#DDCCFF',$allowed, |
| |
$self->{outputmode} eq 'source').'</td>'; |
| } |
} |
| } |
} |
| return $row_html; |
return $row_html; |
|
Line 1294 sub html_template_row {
|
Line 1310 sub html_template_row {
|
| $row_html .= '<td bgcolor="'.$importcolor.'">'. |
$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="#E0FFDD">'. |
| &html_editable_cell($cell,'#EOFFDD',$allowed).'</td>'; |
&html_editable_cell($cell,'#E0FFDD',$allowed, |
| |
$self->{outputmode} eq 'source').'</td>'; |
| } |
} |
| } |
} |
| return $row_html; |
return $row_html; |
| } |
} |
| |
|
| sub html_editable_cell { |
sub html_editable_cell { |
| my ($cell,$bgcolor,$allowed) = @_; |
my ($cell,$bgcolor,$allowed,$showsource) = @_; |
| my $result; |
my $result; |
| my ($name,$formula,$value); |
my ($name,$formula,$value); |
| if (defined($cell)) { |
if (defined($cell)) { |
|
Line 1312 sub html_editable_cell {
|
Line 1329 sub html_editable_cell {
|
| } |
} |
| $name = '' if (! defined($name)); |
$name = '' if (! defined($name)); |
| $formula = '' if (! defined($formula)); |
$formula = '' if (! defined($formula)); |
| if (! defined($value)) { |
if ($showsource) { |
| |
if (!defined($formula) || $formula =~ /^\s*$/) { |
| |
$value = '<font color="'.$bgcolor.'">#</font>'; |
| |
} else { |
| |
$value = &HTML::Entities::encode($formula, '<>&"'); |
| |
} |
| |
} elsif (! defined($value)) { |
| $value = '<font color="'.$bgcolor.'">#</font>'; |
$value = '<font color="'.$bgcolor.'">#</font>'; |
| if ($formula ne '') { |
if ($formula ne '') { |
| $value = '<i>undefined value</i>'; |
$value = '<i>undefined value</i>'; |
|
Line 1329 sub html_editable_cell {
|
Line 1352 sub html_editable_cell {
|
| # |
# |
| # The encoding string "^A-blah" is placed in []'s inside a regexp, so |
# The encoding string "^A-blah" is placed in []'s inside a regexp, so |
| # we specify the characters we want left alone by putting a '^' in front. |
# we specify the characters we want left alone by putting a '^' in front. |
| $formula = &HTML::Entities::encode($formula,'^A-z0-9 !#$%-;=?~'); |
$formula = &HTML::Entities::encode($formula,'^A-z0-9 !#$%;=?~-'); |
| # HTML::Entities::encode does not catch everything - we need '\' encoded |
# HTML::Entities::encode does not catch everything - we need '\' encoded |
| $formula =~ s/\\/&\#092/g; |
$formula =~ s/\\/&\#092/g; |
| # Escape it again - this time the only encodable character is '&' |
# Escape it again - this time the only encodable character is '&' |
|
Line 1364 sub html_row {
|
Line 1387 sub html_row {
|
| $row_html .= '<td bgcolor="'.$color.'">'; |
$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="#E0FFDD">'; |
| $row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed); |
$row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed, |
| |
$self->{outputmode} eq 'source'); |
| } |
} |
| $row_html .= '</td>'; |
$row_html .= '</td>'; |
| } |
} |
|
Line 1389 sub output_options {
|
Line 1413 sub output_options {
|
| description => 'HTML'}, |
description => 'HTML'}, |
| {value => 'excel', |
{value => 'excel', |
| description => 'Excel'}, |
description => 'Excel'}, |
| |
{value => 'source', |
| |
description => 'Show Source'}, |
| # {value => 'xml', |
# {value => 'xml', |
| # description => 'XML'}, |
# description => 'XML'}, |
| {value => 'csv', |
{value => 'csv', |
|
Line 1407 sub output_selector {
|
Line 1433 sub output_selector {
|
| foreach ($self->output_options()) { |
foreach ($self->output_options()) { |
| $output_selector.='<option value="'.$_->{'value'}.'"'; |
$output_selector.='<option value="'.$_->{'value'}.'"'; |
| if ($_->{'value'} eq $default) { |
if ($_->{'value'} eq $default) { |
| $output_selector .= ' selected'; |
$output_selector .= ' selected="selected"'; |
| } |
} |
| $output_selector .= ">".&mt($_->{'description'})."</option>\n"; |
$output_selector .= ">".&mt($_->{'description'})."</option>\n"; |
| } |
} |
|
Line 1484 sub outsheet_excel {
|
Line 1510 sub outsheet_excel {
|
| # |
# |
| # Write a link to allow them to download it |
# Write a link to allow them to download it |
| $r->print('<br />'. |
$r->print('<br />'. |
| '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n"); |
'<a href="'.$filename.'">'.&mt('Your Excel spreadsheet').'</a>'."\n"); |
| return; |
return; |
| } |
} |
| |
|
|
Line 1502 sub outsheet_csv {
|
Line 1528 sub outsheet_csv {
|
| 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(&mt("Problems occured in writing the csv file. ". |
$r->print( |
| "This error has been logged. ". |
'<p class="LC_error">' |
| "Please alert your LON-CAPA administrator.")); |
.&mt('Problems occurred in writing the CSV file.') |
| |
.' '.&mt('This error has been logged.') |
| |
.' '.&mt('Please alert your LON-CAPA administrator.') |
| |
.'</p>' |
| |
); |
| $r->print("<pre>\n".$csvdata."</pre>\n"); |
$r->print("<pre>\n".$csvdata."</pre>\n"); |
| return 0; |
return 0; |
| } |
} |
|
Line 1524 sub outsheet_csv {
|
Line 1554 sub outsheet_csv {
|
| # Output the body of the spreadsheet |
# Output the body of the spreadsheet |
| $self->csv_rows($connection,$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.'">'.&mt('Your CSV spreadsheet.').'</a>'."\n"); |
'<a href="'.$filename.'">'.&mt('Your CSV spreadsheet.').'</a>'."\n"); |
|
Line 1562 sub outsheet_xml {
|
Line 1592 sub outsheet_xml {
|
| ## Will be rendered for the user |
## Will be rendered for the user |
| ## But not on this day |
## But not on this day |
| my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n"; |
my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n"; |
| |
$self->check_formulas_loaded(); |
| while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { |
while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { |
| if ($cell =~ /^template_(\w+)/) { |
if ($cell =~ /^template_(\w+)/) { |
| my $col = $1; |
my $col = $1; |
|
Line 1644 sub load {
|
Line 1675 sub load {
|
| my $stype = $self->{'type'}; |
my $stype = $self->{'type'}; |
| my $cnum = $self->{'cnum'}; |
my $cnum = $self->{'cnum'}; |
| my $cdom = $self->{'cdom'}; |
my $cdom = $self->{'cdom'}; |
| my $chome = $self->{'chome'}; |
|
| # |
# |
| my $filename = $self->filename(); |
my $filename = $self->filename(); |
| my $cachekey = join('_',($cnum,$cdom,$stype,$filename)); |
my $cachekey = join('_',($cnum,$cdom,$stype,$filename)); |
|
Line 1653 sub load {
|
Line 1683 sub load {
|
| my ($formulas); |
my ($formulas); |
| if (exists($spreadsheets{$cachekey})) { |
if (exists($spreadsheets{$cachekey})) { |
| $formulas = $spreadsheets{$cachekey}->{'formulas'}; |
$formulas = $spreadsheets{$cachekey}->{'formulas'}; |
| |
$self->formulas($formulas); |
| |
$self->{'row_source'}=$spreadsheets{$cachekey}->{'row_source'}; |
| |
$self->{'row_numbers'}=$spreadsheets{$cachekey}->{'row_numbers'}; |
| |
$self->{'maxrow'}=$spreadsheets{$cachekey}->{'maxrow'}; |
| } else { |
} else { |
| # Not cached, need to read |
# Not cached, need to read |
| if (! defined($filename)) { |
if (! defined($filename)) { |
|
Line 1662 sub load {
|
Line 1696 sub load {
|
| my $sheetxml=&Apache::lonnet::getfile |
my $sheetxml=&Apache::lonnet::getfile |
| (&Apache::lonnet::filelocation('',$filename)); |
(&Apache::lonnet::filelocation('',$filename)); |
| if ($sheetxml == -1) { |
if ($sheetxml == -1) { |
| $sheetxml='<field row="0" col="A">"Error loading spreadsheet ' |
$sheetxml='<field row="0" col="A">'. |
| .$self->filename().'"</field>'; |
&mt('Error loading spreadsheet [_1]', |
| |
'"'.$self->filename().'"'). |
| |
'</field>'; |
| } |
} |
| ($formulas,undef) = &parse_sheet(\$sheetxml); |
($formulas,undef) = &parse_sheet(\$sheetxml); |
| # Get just the filename and set the sheets filename |
# Get just the filename and set the sheets filename |
|
Line 1678 sub load {
|
Line 1714 sub load {
|
| # Load the spreadsheet definition file from the save file |
# Load the spreadsheet definition file from the save file |
| my %tmphash = &Apache::lonnet::dump($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 (%tmphash |
| |
&& $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; |
| } |
} |
|
Line 1686 sub load {
|
Line 1723 sub load {
|
| $formulas = $self->load_system_default_sheet(); |
$formulas = $self->load_system_default_sheet(); |
| } |
} |
| } |
} |
| $filename=$self->filename(); # filename may have changed |
$self->formulas($formulas); |
| $cachekey = join('_',($cnum,$cdom,$stype,$filename)); |
$self->set_row_sources(); |
| %{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas}; |
$self->set_row_numbers(); |
| |
$self->cache_sheet($formulas); |
| } |
} |
| $self->formulas($formulas); |
} |
| $self->set_row_sources(); |
|
| $self->set_row_numbers(); |
sub cache_sheet { |
| |
my $self = shift; |
| |
my ($formulas) = @_; |
| |
my $stype = $self->{'type'}; |
| |
my $cnum = $self->{'cnum'}; |
| |
my $cdom = $self->{'cdom'}; |
| |
# |
| |
my $filename = $self->filename(); |
| |
my $cachekey = join('_',($cnum,$cdom,$stype,$filename)); |
| |
|
| |
if (ref($formulas) eq 'HASH') { |
| |
%{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas}; |
| |
} |
| |
if (ref($self->{'row_source'})) { |
| |
%{$spreadsheets{$cachekey}->{'row_source'}} =%{$self->{'row_source'}}; |
| |
} |
| |
if (ref($self->{'row_numbers'})) { |
| |
%{$spreadsheets{$cachekey}->{'row_numbers'}}=%{$self->{'row_numbers'}}; |
| |
} |
| |
$spreadsheets{$cachekey}->{'maxrow'} = $self->{'maxrow'}; |
| } |
} |
| |
|
| sub set_row_sources { |
sub set_row_sources { |
| my $self = shift; |
my $self = shift; |
| |
$self->check_formulas_loaded(); |
| while (my ($cell,$value) = each(%{$self->{'formulas'}})) { |
while (my ($cell,$value) = each(%{$self->{'formulas'}})) { |
| next if ($cell !~ /^A(\d+)/ || $1 < 1); |
next if ($cell !~ /^A(\d+)/ || $1 < 1); |
| my $row = $1; |
my $row = $1; |
|
Line 1707 sub set_row_sources {
|
Line 1765 sub set_row_sources {
|
| |
|
| sub set_row_numbers { |
sub set_row_numbers { |
| my $self = shift; |
my $self = shift; |
| |
$self->check_formulas_loaded(); |
| while (my ($cell,$value) = each(%{$self->{'formulas'}})) { |
while (my ($cell,$value) = each(%{$self->{'formulas'}})) { |
| next if ($cell !~ /^A(\d+)$/); |
next if ($cell !~ /^A(\d+)$/); |
| next if (! defined($value)); |
next if (! defined($value)); |
|
Line 1741 sub save {
|
Line 1800 sub save {
|
| my $stype = $self->{'type'}; |
my $stype = $self->{'type'}; |
| my $cnum = $self->{'cnum'}; |
my $cnum = $self->{'cnum'}; |
| my $cdom = $self->{'cdom'}; |
my $cdom = $self->{'cdom'}; |
| my $chome = $self->{'chome'}; |
|
| my $filename = $self->{'filename'}; |
my $filename = $self->{'filename'}; |
| my $cachekey = join('_',($cnum,$cdom,$stype,$filename)); |
|
| # Cache new sheet |
# Cache new sheet |
| %{$spreadsheets{$cachekey}->{'formulas'}}=%f; |
$self->cache_sheet(\%f); |
| # Write sheet |
# Write sheet |
| foreach (keys(%f)) { |
foreach (keys(%f)) { |
| delete($f{$_}) if ($f{$_} eq 'import'); |
delete($f{$_}) if ($f{$_} eq 'import'); |
|
Line 1761 sub save {
|
Line 1818 sub save {
|
| {'spreadsheet_default_'.$stype => $filename }, |
{'spreadsheet_default_'.$stype => $filename }, |
| $cdom,$cnum); |
$cdom,$cnum); |
| return $reply if ($reply ne 'ok'); |
return $reply if ($reply ne 'ok'); |
| |
&Apache::lonnet::appenv({'course.'.$self->{'cid'}.'.spreadsheet_default_'. |
| |
$self->{'type'} => $self->filename()}); |
| } |
} |
| if ($self->is_default()) { |
if ($self->{'type'} eq 'studentcalc') { |
| if ($self->{'type'} eq 'studentcalc') { |
&Apache::lonnet::expirespread('','','studentcalc',''); |
| &Apache::lonnet::expirespread('','','studentcalc',''); |
} elsif ($self->{'type'} eq 'assesscalc') { |
| } elsif ($self->{'type'} eq 'assesscalc') { |
&Apache::lonnet::expirespread('','','assesscalc',''); |
| &Apache::lonnet::expirespread('','','assesscalc',''); |
&Apache::lonnet::expirespread('','','studentcalc',''); |
| &Apache::lonnet::expirespread('','','studentcalc',''); |
|
| } |
|
| } |
} |
| return $reply; |
return $reply; |
| } |
} |
|
Line 1790 sub save_tmp {
|
Line 1847 sub save_tmp {
|
| my %f = $self->formulas(); |
my %f = $self->formulas(); |
| while( my ($cell,$formula) = each(%f)) { |
while( my ($cell,$formula) = each(%f)) { |
| next if ($formula eq 'import'); |
next if ($formula eq 'import'); |
| print $fh &Apache::lonnet::escape($cell)."=". |
print $fh &escape($cell)."=". |
| &Apache::lonnet::escape($formula)."\n"; |
&escape($formula)."\n"; |
| } |
} |
| $fh->close(); |
$fh->close(); |
| } |
} |
|
Line 1809 sub load_tmp {
|
Line 1866 sub load_tmp {
|
| while (<$spreadsheet_file>) { |
while (<$spreadsheet_file>) { |
| chomp; |
chomp; |
| my ($cell,$formula) = split(/=/); |
my ($cell,$formula) = split(/=/); |
| $cell = &Apache::lonnet::unescape($cell); |
$cell = &unescape($cell); |
| $formula = &Apache::lonnet::unescape($formula); |
$formula = &unescape($formula); |
| $formulas{$cell} = $formula; |
$formulas{$cell} = $formula; |
| } |
} |
| $spreadsheet_file->close(); |
$spreadsheet_file->close(); |
|
Line 1853 sub othersheets {
|
Line 1910 sub othersheets {
|
| my ($stype) = @_; |
my ($stype) = @_; |
| $stype = $self->{'type'} if (! defined($stype) || $stype !~ /calc$/); |
$stype = $self->{'type'} if (! defined($stype) || $stype !~ /calc$/); |
| # |
# |
| my @alternatives=(); |
my @alternatives=(&mt('Default'), &mt('LON-CAPA Standard')); |
| my %results=&Apache::lonnet::dump($stype.'_spreadsheets', |
my %results=&Apache::lonnet::dump($stype.'_spreadsheets', |
| $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 (%results |
| @alternatives = (&mt('Default')); |
&& $tmp !~ /^(con_lost|error|no_such_host)/i ) { |
| } else { |
push(@alternatives, sort(keys(%results))); |
| @alternatives = (&mt('Default'), sort (keys(%results))); |
|
| } |
} |
| return @alternatives; |
return @alternatives; |
| } |
} |
![[BACK]](/icons/back.gif){kind=icon}
Return to Spreadsheet.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface / spreadsheet