# # $Id: Spreadsheet.pm,v 1.25 2003/09/12 18:59:48 matthew Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # The LearningOnline Network with CAPA # Spreadsheet/Grades Display Handler # # POD required stuff: =head1 NAME Spreadsheet =head1 SYNOPSIS =head1 DESCRIPTION =over 4 =cut ################################################### ################################################### ### Spreadsheet ### ################################################### ################################################### package Apache::Spreadsheet; use strict; #use warnings FATAL=>'all'; #no warnings 'uninitialized'; use Apache::Constants qw(:common :http); use Apache::lonnet; use Safe; use Safe::Hole; use Opcode; use HTML::Entities(); use HTML::TokeParser; use Spreadsheet::WriteExcel; use Time::HiRes; ## ## Package Variables ## my %expiredates; my @UC_Columns = split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); my @LC_Columns = split(//,'abcdefghijklmnopqrstuvwxyz'); ###################################################### =pod =item &new Returns a new spreadsheet object. =cut ###################################################### sub new { my $this = shift; my $class = ref($this) || $this; my ($stype) = ($class =~ /Apache::(.*)$/); # my ($name,$domain,$filename,$usymb)=@_; # my $self = { name => $name, domain => $domain, type => $stype, symb => $usymb, errorlog => '', maxrow => 0, cid => $ENV{'request.course.id'}, cnum => $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, cdom => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, chome => $ENV{'course.'.$ENV{'request.course.id'}.'.home'}, coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'}, 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 formulas => {}, constants => {}, rows => [], row_source => {}, othersheets => [], }; # $self->{'uhome'} = &Apache::lonnet::homeserver($name,$domain); # bless($self,$class); # # Load in the spreadsheet definition $self->filename($filename); if (exists($ENV{'form.workcopy'}) && $self->{'type'} eq $ENV{'form.workcopy'}) { $self->load_tmp(); } else { $self->load(); } return $self; } ###################################################### =pod =item &filename get or set the filename for a spreadsheet. =cut ###################################################### sub filename { my $self = shift(); if (@_) { my ($newfilename) = @_; if (! defined($newfilename) || $newfilename eq 'Default' || $newfilename !~ /\w/ || $newfilename eq '') { my $key = 'course.'.$self->{'cid'}.'.spreadsheet_default_'. $self->{'type'}; if (exists($ENV{$key}) && $ENV{$key} ne '') { $newfilename = $ENV{$key}; } else { $newfilename = 'default_'.$self->{'type'}; } } if ($newfilename !~ /\w/ || $newfilename =~ /^\W*$/) { $newfilename = 'default_'.$self->{'type'}; } if ($newfilename !~ /^default\.$self->{'type'}$/ ) { if ($newfilename !~ /_$self->{'type'}$/) { $newfilename =~ s/[\s_]*$//; $newfilename .= '_'.$self->{'type'}; } } $self->{'filename'} = $newfilename; return; } return $self->{'filename'}; } ###################################################### =pod =item &make_default() Make the current spreadsheet file the default for the course. Expires all the default spreadsheets.......! =cut ###################################################### sub make_default { my $self = shift(); my $result = &Apache::lonnet::put('environment', {'spreadsheet_default_'.$self->{'type'} => $self->filename()}, $self->{'cdom'},$self->{'cnum'}); return $result if ($result ne 'ok'); my $symb = $self->{'symb'}; $symb = '' if (! defined($symb)); &Apache::lonnet::expirespread('','',$self->{'type'},$symb); } ###################################################### =pod =item &is_default() Returns 1 if the current spreadsheet is the default as specified in the course environment. Returns 0 otherwise. =cut ###################################################### sub is_default { my $self = shift; # Check to find out if we are the default spreadsheet (filenames match) my $default_filename = ''; my %tmphash = &Apache::lonnet::get('environment', ['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*$/) { $default_filename = 'default_'.$self->{'type'}; } return 1 if ($self->filename() eq $default_filename); 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 { &load_spreadsheet_expirationdates(); &clear_spreadsheet_definition_cache(); } sub load_spreadsheet_expirationdates { undef %expiredates; my $cid=$ENV{'request.course.id'}; my @tmp = &Apache::lonnet::dump('nohist_expirationdates', $ENV{'course.'.$cid.'.domain'}, $ENV{'course.'.$cid.'.num'}); if (lc($tmp[0]) !~ /^error/){ %expiredates = @tmp; } } sub check_expiration_time { my $self = shift; my ($time)=@_; 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'}.':'; $key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':'; $key3 = $key2.$self->{'container'} if (defined($self->{'container'})); $key4 = $key2.$self->{'symb'} if (defined($self->{'symb'})); $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)); if (exists($expiredates{$key}) && $expiredates{$key} > $time) { $returnvalue = 0; # need to recompute } } return $returnvalue; } ###################################################### =pod =item &initialize_safe_space Returns the safe space required by a Spreadsheet object. =head 2 Safe Space Functions =over 4 =cut ###################################################### { my $safeeval; sub initialize_safe_space { my $self = shift; if (! defined($safeeval)) { $safeeval = new Safe(shift); my $safehole = new Safe::Hole; $safeeval->permit("entereval"); $safeeval->permit(":base_math"); $safeeval->permit("sort"); $safeeval->deny(":base_io"); $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); $safehole->wrap(\&mask,$safeeval,'&mask'); $safeeval->share('$@'); my $code=<<'ENDDEFS'; # ---------------------------------------------------- Inside of the safe space # # f: formulas # t: intermediate format (variable references expanded) # v: output values # c: preloaded constants (A-column) # rl: row label # os: other spreadsheets (for student spreadsheet only) undef %sheet_values; # 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 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 # (spreadsheet authors) data for each cell. undef %c; # Holds the constants for a sheet. In the assessment # sheets, this is the A column. Used in &MINPARM, &MAXPARM, &expandnamed, # &sett, and &constants. There is no &getconstants. # &constants is called by &loadstudent, &loadcourse, &load assessment, undef @os; # Holds the names of other spreadsheets - this is used to specify # the spreadsheets that are available for the assessment sheet. # Set by &setothersheets. &setothersheets is called by &handler. A # related subroutine is &othersheets. $errorlog = ''; # $maxrow = 0; $type = ''; # # filename/reference of the sheet $filename = ''; # # user data $name = ''; $uhome = ''; $domain = ''; # # course data $csec = ''; $chome= ''; $cnum = ''; $cdom = ''; $cid = ''; $coursefilename = ''; # # symb $usymb = ''; # # error messages $errormsg = ''; # #------------------------------------------------------- =pod =item NUM(range) returns the number of items in the range. =cut #------------------------------------------------------- sub NUM { my $mask=&mask(@_); my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1; return $num; } #------------------------------------------------------- =pod =item BIN(low,high,lower,upper) =cut #------------------------------------------------------- sub BIN { my ($low,$high,$lower,$upper)=@_; my $mask=&mask($lower,$upper); my $num=0; foreach (grep /$mask/,keys(%sheet_values)) { if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) { $num++; } } return $num; } #------------------------------------------------------- =pod =item SUM(range) returns the sum of items in the range. =cut #------------------------------------------------------- sub SUM { my $mask=&mask(@_); my $sum=0; foreach (grep /$mask/,keys(%sheet_values)) { $sum+=$sheet_values{$_}; } return $sum; } #------------------------------------------------------- =pod =item MEAN(range) compute the average of the items in the range. =cut #------------------------------------------------------- sub MEAN { my $mask=&mask(@_); my $sum=0; my $num=0; foreach (grep /$mask/,keys(%sheet_values)) { $sum+=$sheet_values{$_}; $num++; } if ($num) { return $sum/$num; } else { return undef; } } #------------------------------------------------------- =pod =item STDDEV(range) compute the standard deviation of the items in the range. =cut #------------------------------------------------------- sub STDDEV { my $mask=&mask(@_); my $sum=0; my $num=0; foreach (grep /$mask/,keys(%sheet_values)) { $sum+=$sheet_values{$_}; $num++; } unless ($num>1) { return undef; } my $mean=$sum/$num; $sum=0; foreach (grep /$mask/,keys(%sheet_values)) { $sum+=($sheet_values{$_}-$mean)**2; } return sqrt($sum/($num-1)); } #------------------------------------------------------- =pod =item PROD(range) compute the product of the items in the range. =cut #------------------------------------------------------- sub PROD { my $mask=&mask(@_); my $prod=1; foreach (grep /$mask/,keys(%sheet_values)) { $prod*=$sheet_values{$_}; } return $prod; } #------------------------------------------------------- =pod =item MAX(range) compute the maximum of the items in the range. =cut #------------------------------------------------------- sub MAX { my $mask=&mask(@_); my $max='-'; foreach (grep /$mask/,keys(%sheet_values)) { unless ($max) { $max=$sheet_values{$_}; } if (($sheet_values{$_}>$max) || ($max eq '-')) { $max=$sheet_values{$_}; } } return $max; } #------------------------------------------------------- =pod =item MIN(range) compute the minimum of the items in the range. =cut #------------------------------------------------------- sub MIN { my $mask=&mask(@_); my $min='-'; foreach (grep /$mask/,keys(%sheet_values)) { unless ($max) { $max=$sheet_values{$_}; } if (($sheet_values{$_}<$min) || ($min eq '-')) { $min=$sheet_values{$_}; } } return $min; } #------------------------------------------------------- =pod =item SUMMAX(num,lower,upper) compute the sum of the largest 'num' items in the range from 'lower' to 'upper' =cut #------------------------------------------------------- sub SUMMAX { my ($num,$lower,$upper)=@_; my $mask=&mask($lower,$upper); my @inside=(); foreach (grep /$mask/,keys(%sheet_values)) { push (@inside,$sheet_values{$_}); } @inside=sort(@inside); my $sum=0; my $i; for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { $sum+=$inside[$i]; } return $sum; } #------------------------------------------------------- =pod =item SUMMIN(num,lower,upper) compute the sum of the smallest 'num' items in the range from 'lower' to 'upper' =cut #------------------------------------------------------- sub SUMMIN { my ($num,$lower,$upper)=@_; my $mask=&mask($lower,$upper); my @inside=(); foreach (grep /$mask/,keys(%sheet_values)) { $inside[$#inside+1]=$sheet_values{$_}; } @inside=sort(@inside); my $sum=0; my $i; for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { $sum+=$inside[$i]; } return $sum; } #------------------------------------------------------- =pod =item MINPARM(parametername) Returns the minimum value of the parameters matching the parametername. parametername should be a string such as 'duedate'. =cut #------------------------------------------------------- sub MINPARM { my ($expression) = @_; my $min = undef; study($expression); foreach $parameter (keys(%c)) { next if ($parameter !~ /$expression/); if ((! defined($min)) || ($min > $c{$parameter})) { $min = $c{$parameter} } } return $min; } #------------------------------------------------------- =pod =item MAXPARM(parametername) Returns the maximum value of the parameters matching the input parameter name. parametername should be a string such as 'duedate'. =cut #------------------------------------------------------- sub MAXPARM { my ($expression) = @_; my $max = undef; study($expression); foreach $parameter (keys(%c)) { next if ($parameter !~ /$expression/); if ((! defined($min)) || ($max < $c{$parameter})) { $max = $c{$parameter} } } return $max; } sub calc { %sheet_values = %t; my $notfinished = 1; my $lastcalc = ''; my $depth = 0; while ($notfinished) { $notfinished=0; while (my ($cell,$value) = each(%t)) { my $old=$sheet_values{$cell}; $sheet_values{$cell}=eval $value; # $errorlog .= $cell.' = '.$old.'->'.$sheet_values{$cell}."\n"; if ($@) { undef %sheet_values; return $cell.': '.$@; } if ($sheet_values{$cell} ne $old) { $notfinished=1; $lastcalc=$cell; } } # $errorlog.="------------------------------------------------"; $depth++; if ($depth>100) { undef %sheet_values; return $lastcalc.': Maximum calculation depth exceeded'; } } return ''; } # ------------------------------------------- End of "Inside of the safe space" ENDDEFS $safeeval->reval($code); } $self->{'safe'} = $safeeval; $self->{'root'} = $self->{'safe'}->root(); # # Place some of the %$self items into the safe space except the safe space # itself my $initstring = ''; foreach (qw/name domain type usymb cid csec coursefilename cnum cdom chome uhome/) { $initstring.= qq{\$$_="$self->{$_}";}; } $self->{'safe'}->reval($initstring); return $self; } } ###################################################### =pod =back =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-Za-z]|\*)(\d+|\*)/); my ($ua,$ud) = ($upper=~/([A-Za-z]|\*)(\d+|\*)/); # my $alpha=''; my $num=''; # if (($la eq '*') || ($ua eq '*')) { $alpha='[A-Za-z]'; } else { if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) || ($la=~/[a-z]/) && ($ua=~/[a-z]/)) { $alpha='['.$la.'-'.$ua.']'; } else { $alpha='['.$la.'-Za-'.$ua.']'; } } if (($ld eq '*') || ($ud eq '*')) { $num='\d+'; } else { if (length($ld)!=length($ud)) { $num.='('; foreach ($ld=~m/\d/g) { $num.='['.$_.'-9]'; } if (length($ud)-length($ld)>1) { $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}'; } $num.='|'; foreach ($ud=~m/\d/g) { $num.='[0-'.$_.']'; } $num.=')'; } else { my @lda=($ld=~m/\d/g); my @uda=($ud=~m/\d/g); my $i; my $j=0; my $notdone=1; for ($i=0;($i<=$#lda)&&($notdone);$i++) { if ($lda[$i]==$uda[$i]) { $num.=$lda[$i]; $j=$i; } else { $notdone=0; } } if ($j<$#lda-1) { $num.='('.$lda[$j+1]; for ($i=$j+2;$i<=$#lda;$i++) { $num.='['.$lda[$i].'-9]'; } if ($uda[$j+1]-$lda[$j+1]>1) { $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'. ($#lda-$j-1).'}'; } $num.='|'.$uda[$j+1]; for ($i=$j+2;$i<=$#uda;$i++) { $num.='[0-'.$uda[$i].']'; } $num.=')'; } else { if ($lda[-1]!=$uda[-1]) { $num.='['.$lda[-1].'-'.$uda[-1].']'; } } } } my $expression ='^'.$alpha.$num."\$"; $memoizer{$key} = $expression; return $expression; } } ## ## sub add_hash_to_safe {} # spreadsheet, would like to destroy ## # # expandnamed used to reside in the safe space # sub expandnamed { my $self = shift; my $expression=shift; if ($expression=~/^\&/) { my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/); my @vars=split(/\W+/,$formula); my %values=(); foreach my $varname ( @vars ) { if ($varname=~/^(parameter|stores|timestamp)/) { $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge; $varname=~s/$var/\([\\w:\\- ]\+\)/g; foreach (keys(%{$self->{'constants'}})) { if ($_=~/$varname/) { $values{$1}=1; } } } } if ($func eq 'EXPANDSUM') { my $result=''; foreach (keys(%values)) { my $thissum=$formula; $thissum=~s/$var/$_/g; $result.=$thissum.'+'; } $result=~s/\+$//; return $result; } else { return 0; } } else { # it is not a function, so it is a parameter name # We should do the following: # 1. Take the list of parameter names # 2. look through the list for ones that match the parameter we want # 3. If there are no collisions, return the one that matches # 4. If there is a collision, return 'bad parameter name error' my $returnvalue = ''; my @matches = (); my @values = (); $#matches = -1; study $expression; while (my($parameter,$value) = each(%{$self->{'constants'}})) { next if ($parameter !~ /$expression/); push(@matches,$parameter); push(@values,$value); } if (scalar(@matches) == 0) { $returnvalue = '""';#'"unmatched parameter: '.$parameter.'"'; } elsif (scalar(@matches) == 1) { # why do we not do this lookup here, instead of delaying it? $returnvalue = $values[0]; } elsif (scalar(@matches) > 0) { # more than one match. Look for a concise one $returnvalue = "'non-unique parameter name : $expression'"; for (my $i=0; $i<=$#matches;$i++) { if ($matches[$i] =~ /^$expression$/) { # why do we not do this lookup here? $returnvalue = $values[$i]; } } } else { # There was a negative number of matches, which indicates # something is wrong with reality. Better warn the user. $returnvalue = '"bizzare parameter: '.$expression.'"'; } return $returnvalue; } } sub sett { my $self = shift; my %t=(); # # Deal with the template row foreach my $col ($self->template_cells()) { next if ($col=~/^[A-Z]/); foreach my $row ($self->rows()) { # Get the name of this cell my $cell=$col.$row; # Grab the template declaration $t{$cell}=$self->formula('template_'.$col); # Replace '#' with the row number $t{$cell}=~s/\#/$row/g; # Replace '....' with ',' $t{$cell}=~s/\.\.+/\,/g; # Replace 'A0' with the value from 'A0' $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; # Replace parameters $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; } } # # Deal with the normal cells while (my($cell,$formula) = each(%{$self->{'formulas'}})) { next if ($_=~/^template\_/); my ($col,$row) = ($cell =~ /^([A-z])(\d+)$/); if ($row eq '0') { $t{$cell}=$formula; $t{$cell}=~s/\.\.+/\,/g; $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; } elsif ( $col =~ /^[A-Z]$/ ) { if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell})) { my $data = $self->{'constants'}->{$cell}; $t{$cell} = $data; } } else { # $row > 1 and $col =~ /[a-z] $t{$cell}=$formula; $t{$cell}=~s/\.\.+/\,/g; $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; } } %{$self->{'safe'}->varglob('t')}=%t; } ## ## sync_safe_space: Called by calcsheet to make sure all the data we # need to calculate is placed into the safe space ## sub sync_safe_space { my $self = shift; # Inside the safe space 'formulas' has a diabolical alter-ego named 'f'. %{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}}; # 'constants' leads a peaceful hidden life of 'c'. %{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}}; # 'othersheets' hides as 'os', a disguise few can penetrate. @{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}}; } ## ## Retrieve the error log from the safe space (used for debugging) ## sub get_errorlog { my $self = shift; $self->{'errorlog'} = $ { $self->{'safe'}->varglob('errorlog') }; return $self->{'errorlog'}; } ## ## Clear the error log inside the safe space ## sub clear_errorlog { my $self = shift; $ {$self->{'safe'}->varglob('errorlog')} = ''; $self->{'errorlog'} = ''; } ## ## constants: either set or get the constants ## sub constants { my $self=shift; my ($constants) = @_; if (defined($constants)) { if (! ref($constants)) { my %tmp = @_; $constants = \%tmp; } $self->{'constants'} = $constants; return; } else { return %{$self->{'constants'}}; } } ## ## formulas: either set or get the formulas ## sub formulas { my $self=shift; my ($formulas) = @_; if (defined($formulas)) { if (! ref($formulas)) { my %tmp = @_; $formulas = \%tmp; } $self->{'formulas'} = $formulas; $self->{'rows'} = []; $self->{'template_cells'} = []; return; } else { return %{$self->{'formulas'}}; } } sub set_formula { my $self = shift; my ($cell,$formula) = @_; $self->{'formulas'}->{$cell}=$formula; return; } ## ## formulas_keys: Return the keys to the formulas hash. ## sub formulas_keys { my $self = shift; my @keys = keys(%{$self->{'formulas'}}); return keys(%{$self->{'formulas'}}); } ## ## formula: Return the formula for a given cell in the spreadsheet ## returns '' if the cell does not have a formula or does not exist ## sub formula { my $self = shift; my $cell = shift; if (defined($cell) && exists($self->{'formulas'}->{$cell})) { return $self->{'formulas'}->{$cell}; } return ''; } ## ## logthis: write the input to lonnet.log ## sub logthis { my $self = shift; my $message = shift; &Apache::lonnet::logthis($self->{'type'}.':'. $self->{'name'}.':'.$self->{'domain'}.':'. $message); return; } ## ## dump_formulas_to_log: makes lonnet.log huge... ## sub dump_formulas_to_log { my $self =shift; $self->logthis("Spreadsheet formulas"); $self->logthis("--------------------------------------------------------"); while (my ($cell, $formula) = each(%{$self->{'formulas'}})) { $self->logthis(' '.$cell.' = '.$formula); } $self->logthis("--------------------------------------------------------");} ## ## value: returns the computed value of a particular cell ## sub value { my $self = shift; my $cell = shift; if (defined($cell) && exists($self->{'values'}->{$cell})) { return $self->{'values'}->{$cell}; } return ''; } ## ## dump_values_to_log: makes lonnet.log huge... ## sub dump_values_to_log { my $self =shift; $self->logthis("Spreadsheet Values"); $self->logthis("------------------------------------------------------"); while (my ($cell, $value) = each(%{$self->{'values'}})) { $self->logthis(' '.$cell.' = '.$value); } $self->logthis("------------------------------------------------------"); } ## ## Yet another debugging function ## sub dump_hash_to_log { my $self= shift(); my %tmp = @_; if (@_<2) { %tmp = %{$_[0]}; } $self->logthis('---------------------------- (begin hash dump)'); while (my ($key,$val) = each (%tmp)) { $self->logthis(' '.$key.' = '.$val.':'); } $self->logthis('---------------------------- (finished hash dump)'); } ## ## rebuild_stats: rebuilds the rows and template_cells arrays ## sub rebuild_stats { my $self = shift; $self->{'rows'}=[]; $self->{'template_cells'}=[]; while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { push(@{$self->{'rows'}},$1) if ($cell =~ /^A(\d+)/ && $1 != 0); push(@{$self->{'template_cells'}},$1) if ($cell =~ /^template_(\w+)/); } return; } ## ## template_cells returns a list of the cells defined in the template row ## sub template_cells { my $self = shift; $self->rebuild_stats() if (! defined($self->{'template_cells'}) || ! @{$self->{'template_cells'}}); return @{$self->{'template_cells'}}; } ## ## Sigh.... ## sub setothersheets { my $self = shift; my @othersheets = @_; $self->{'othersheets'} = \@othersheets; } ## ## rows returns a list of the names of cells defined in the A column ## sub rows { my $self = shift; $self->rebuild_stats() if (!@{$self->{'rows'}}); return @{$self->{'rows'}}; } # # calcsheet: makes all the calls to compute the spreadsheet. # sub calcsheet { my $self = shift; $self->sync_safe_space(); $self->clear_errorlog(); $self->sett(); my $result = $self->{'safe'}->reval('&calc();'); # $self->logthis($self->get_errorlog()); %{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')}; # $self->logthis($self->get_errorlog()); return $result; } ########################################################### ## ## Output Helpers ## ########################################################### sub display { my $self = shift; my ($r) = @_; $self->compute($r); my $outputmode = 'html'; if ($ENV{'form.output_format'} =~ /^(html|excel|csv)$/) { $outputmode = $ENV{'form.output_format'}; } if ($outputmode eq 'html') { $self->outsheet_html($r); } elsif ($outputmode eq 'excel') { $self->outsheet_excel($r); } elsif ($outputmode eq 'csv') { $self->outsheet_csv($r); } $self->cleanup(); return; } ############################################ ## HTML output routines ## ############################################ sub html_export_row { my $self = shift(); my ($color) = @_; $color = '#CCCCFF' if (! defined($color)); my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); my $row_html; my @rowdata = $self->get_row(0); foreach my $cell (@rowdata) { if ($cell->{'name'} =~ /^[A-Z]/) { $row_html .= ''. &html_editable_cell($cell,$color,$allowed).''; } else { $row_html .= ''. &html_editable_cell($cell,'#DDCCFF',$allowed).''; } } return $row_html; } sub html_template_row { my $self = shift(); my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); my ($num_uneditable,$importcolor) = @_; my $row_html; my @rowdata = $self->get_template_row(); my $count = 0; for (my $i = 0; $i<=$#rowdata; $i++) { my $cell = $rowdata[$i]; if ($i < $num_uneditable) { $row_html .= ''. &html_uneditable_cell($cell,'#FFDDDD',$allowed).''; } else { $row_html .= ''. &html_editable_cell($cell,'#EOFFDD',$allowed).''; } } return $row_html; } sub html_editable_cell { my ($cell,$bgcolor,$allowed) = @_; my $result; my ($name,$formula,$value); if (defined($cell)) { $name = $cell->{'name'}; $formula = $cell->{'formula'}; $value = $cell->{'value'}; } $name = '' if (! defined($name)); $formula = '' if (! defined($formula)); if (! defined($value)) { $value = '#'; if ($formula ne '') { $value = 'undefined value'; } } elsif ($value =~ /^\s*$/ ) { $value = '#'; } else { $value = &HTML::Entities::encode($value) if ($value !~/ /); } return $value if (! $allowed); # # The formula will be parsed by the browser twice before being # displayed to the user for editing. # # 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. $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 $result .= "".$value.""; return $result; } sub html_uneditable_cell { my ($cell,$bgcolor) = @_; my $value = (defined($cell) ? $cell->{'value'} : ''); $value = &HTML::Entities::encode($value) if ($value !~/ /); return ' '.$value.' '; } sub html_row { my $self = shift(); my ($num_uneditable,$row,$exportcolor,$importcolor) = @_; my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); my @rowdata = $self->get_row($row); my $num_cols_output = 0; my $row_html; my $color = $importcolor; if ($row == 0) { $color = $exportcolor; } $color = '#FFDDDD' if (! defined($color)); foreach my $cell (@rowdata) { if ($num_cols_output++ < $num_uneditable) { $row_html .= ''; $row_html .= &html_uneditable_cell($cell,'#FFDDDD'); } else { $row_html .= ''; $row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed); } $row_html .= ''; } return $row_html; } sub html_header { my $self = shift; return '' if (! $ENV{'request.role.adv'}); return "\n". ''."\n". '\n". "
Output Format
'.&output_selector()."
\n"; } sub output_selector { my $output_selector = '