loncom/interface/spreadsheet/Spreadsheet.pm - view

File: [LON-CAPA] / loncom / interface / spreadsheet / Spreadsheet.pm
Revision 1.4: download - view: text, annotated - select for diffs
Fri May 23 14:52:51 2003 UTC (21 years, 11 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

No longer save the results of computation of temporary spreadsheets.
Added Spreadsheet->temporary() to handle the getting and setting of the flag
which indicates a spreadsheet is temporary.  studentcalc.pm and assesscalc.pm
check this flag before saving their export rows.

# # $Id: Spreadsheet.pm,v 1.4 2003/05/23 14:52:51 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 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 => '', 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'}, temporary => '', # # 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 =~ /\W/) { 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) { $newfilename=$tmphash{'spreadsheet_default_'.$self->{'type'}}; } } if (! defined($newfilename) || $newfilename !~ /\w/ || $newfilename =~ /^\W*$/) { $newfilename = 'default.'.$self->{'type'}; } else { my $regexp = '_'.$self->{'type'}.'$'; if ($newfilename !~ /$regexp/) { $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'}}; } return 1 if ($self->filename() eq $default_filename); return 0; } 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)=@_; my ($key1,$key2,$key3,$key4); $key1 = '::'.$self->{'type'}.':'; $key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':'; $key3 = $key2.$self->{'container'} if (defined($self->{'container'})); $key4 = $key2.$self->{'usymb'} if (defined($self->{'usymb'})); foreach my $key ($key1,$key2,$key3,$key4) { next if (! defined($key)); if (exists($expiredates{$key}) &&$expiredates{$key} > $time) { return 0; } } return 1; } ###################################################### =pod =item &initialize_safe_space Returns the safe space required by a Spreadsheet object. =head 2 Safe Space Functions =over 4 =cut ###################################################### sub initialize_safe_space { my $self = shift; my $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=~/\D/) { $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 = (); $#matches = -1; study $expression; my $parameter; foreach $parameter (keys(%{$self->{'constants'}})) { push @matches,$parameter if ($parameter =~ /$expression/); } 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 = '$c{\''.$matches[0].'\'}'; } elsif (scalar(@matches) > 0) { # more than one match. Look for a concise one $returnvalue = "'non-unique parameter name : $expression'"; foreach (@matches) { if (/^$expression$/) { # why do we not do this lookup here? $returnvalue = '$c{\''.$_.'\'}'; } } } else { # There was a negative number of matches, which indicates # something is wrong with reality. Better warn the user. $returnvalue = 'bizzare parameter: '.$parameter; } 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 ## ########################################################### ############################################ ## HTML output routines ## ############################################ sub html_export_row { my $self = shift(); 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 .= '<td bgcolor="#CCCCFF">'. &html_editable_cell($cell,'#CCCCFF',$allowed).'</td>'; } else { $row_html .= '<td bgcolor="#DDCCFF">'. &html_editable_cell($cell,'#DDCCFF',$allowed).'</td>'; } } return $row_html; } sub html_template_row { my $self = shift(); my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); my ($num_uneditable) = @_; 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 .= '<td bgcolor="#DDCCFF">'. &html_editable_cell($cell,'#DDCCFF',$allowed).'</td>'; } else { $row_html .= '<td bgcolor="#EOFFDD">'. &html_editable_cell($cell,'#EOFFDD',$allowed).'</td>'; } } 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 = '<font color="'.$bgcolor.'">#</font>'; if ($formula ne '') { $value = '<i>undefined value</i>'; } } elsif ($value =~ /^\s*$/ ) { $value = '<font color="'.$bgcolor.'">#</font>'; } else { $value = &HTML::Entities::encode($value) if ($value !~/ /); } return $value if (! $allowed); # Make the formula safe for outputting $formula =~ s/\'/\"/g; # The formula will be parsed by the browser twice before being # displayed to the user for editing. $formula = &HTML::Entities::encode(&HTML::Entities::encode($formula)); # Escape newlines so they make it into the edit window $formula =~ s/\n/\\n/gs; # Glue everything together $result .= "<a href=\"javascript:celledit(\'". $name."','".$formula."');\">".$value."</a>"; 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) = @_; my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); my @rowdata = $self->get_row($row); my $num_cols_output = 0; my $row_html; foreach my $cell (@rowdata) { if ($num_cols_output++ < $num_uneditable) { $row_html .= '<td bgcolor="#FFDDDD">'; $row_html .= &html_uneditable_cell($cell,'#FFDDDD'); } else { $row_html .= '<td bgcolor="#EOFFDD">'; $row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed); } $row_html .= '</td>'; } return $row_html; } sub create_excel_spreadsheet { my $self = shift; my ($r) = @_; my $filename = '/prtspool/'. $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. time.'_'.rand(1000000000).'.xls'; my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename); if (! defined($workbook)) { $r->log_error("Error creating excel spreadsheet $filename: $!"); $r->print("Problems creating new Excel file. ". "This error has been logged. ". "Please alert your LON-CAPA administrator"); return undef; } # # The excel spreadsheet stores temporary data in files, then put them # together. If needed we should be able to disable this (memory only). # The temporary directory must be specified before calling 'addworksheet'. # File::Temp is used to determine the temporary directory. $workbook->set_tempdir('/home/httpd/perl/tmp'); # # Determine the name to give the worksheet return ($workbook,$filename); } ############################################ ## XML output routines ## ############################################ sub outsheet_xml { my $self = shift; my ($r) = @_; ## Someday XML ## Will be rendered for the user ## But not on this day my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n"; while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { if ($cell =~ /^template_(\d+)/) { my $col = $1; $Str .= '<template col="'.$col.'">'.$formula.'</template>'."\n"; } else { my ($row,$col) = ($cell =~ /^([A-z])(\d+)/); next if (! defined($row) || ! defined($col)); $Str .= '<field row="'.$row.'" col="'.$col.'" >'.$formula.'</cell>' ."\n"; } } $Str.="</spreadsheet>"; return $Str; } ############################################ ### Filesystem routines ### ############################################ sub parse_sheet { # $sheetxml is a scalar reference or a scalar my ($sheetxml) = @_; if (! ref($sheetxml)) { my $tmp = $sheetxml; $sheetxml = \$tmp; } my %formulas; my %sources; my $parser=HTML::TokeParser->new($sheetxml); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { if ($token->[1] eq 'field') { my $cell = $token->[2]->{'col'}.$token->[2]->{'row'}; my $source = $token->[2]->{'source'}; my $formula = $parser->get_text('/field'); $formulas{$cell} = $formula; $sources{$cell} = $source if (defined($source)); $parser->get_text('/field'); } if ($token->[1] eq 'template') { $formulas{'template_'.$token->[2]->{'col'}}= $parser->get_text('/template'); } } } return (\%formulas,\%sources); } { my %spreadsheets; sub clear_spreadsheet_definition_cache { undef(%spreadsheets); } sub load { my $self = shift; my $includedir = $Apache::lonnet::perlvar{'lonIncludes'}; # my $stype = $self->{'type'}; my $cnum = $self->{'cnum'}; my $cdom = $self->{'cdom'}; my $chome = $self->{'chome'}; my $filename = $self->{'filename'}; # my $cachekey = join('_',($cnum,$cdom,$stype,$filename)); # # see if sheet is cached my ($formulas); if (exists($spreadsheets{$cachekey})) { $formulas = $spreadsheets{$cachekey}->{'formulas'}; } else { # Not cached, need to read if (! defined($self->filename())) { # load in the default defined spreadsheet my $sheetxml=''; 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 my $sheetxml=&Apache::lonnet::getfile (&Apache::lonnet::filelocation('',$filename)); if ($sheetxml == -1) { $sheetxml='<field row="0" col="A">"Error loading spreadsheet ' .$self->filename().'"</field>'; } ($formulas,undef) = &parse_sheet(\$sheetxml); } else { # Load the spreadsheet definition file from the save file my %tmphash = &Apache::lonnet::dump($self->filename(),$cdom,$cnum); my ($tmp) = keys(%tmphash); if ($tmp !~ /^(con_lost|error|no_such_host)/i) { while (my ($cell,$formula) = each(%tmphash)) { $formulas->{$cell}=$formula; } } else { # Unable to grab the specified spreadsheet, # so we get the default ones instead. $filename = 'default.'.$stype; $self->filename($filename); my $sheetxml; if (my $fh=Apache::File->new($includedir.'/'.$filename)) { $sheetxml = join('',<$fh>); $fh->close(); } else { $sheetxml='<field row="0" col="A">'. '"Unable to load spreadsheet"</field>'; } ($formulas,undef) = &parse_sheet(\$sheetxml); $self->formulas($formulas); } } $cachekey = join('_',($cnum,$cdom,$stype,$filename)); %{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas}; } $self->formulas($formulas); $self->set_row_sources(); $self->set_row_numbers(); } sub set_row_sources { my $self = shift; while (my ($cell,$value) = each(%{$self->{'formulas'}})) { next if ($cell !~ /^A(\d+)/ && $1 > 0); my $row = $1; $self->{'row_source'}->{$row} = $value; } return; } ## ## exportrow is *not* used to get the export row from a computed sub-sheet. ## sub exportrow { my $self = shift; my @exportarray; foreach my $column (@UC_Columns) { push(@exportarray,$self->value($column.'0')); } return @exportarray; } sub save { my $self = shift; my ($makedef)=@_; my $cid=$self->{'cid'}; # If we are saving it, it must not be temporary $self->temporary(0); if (&Apache::lonnet::allowed('opa',$cid)) { my %f=$self->formulas(); my $stype = $self->{'type'}; my $cnum = $self->{'cnum'}; my $cdom = $self->{'cdom'}; my $chome = $self->{'chome'}; my $fn = $self->{'filename'}; # Cache new sheet $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); # Write sheet foreach (keys(%f)) { delete($f{$_}) if ($f{$_} eq 'import'); } my $reply = &Apache::lonnet::put($fn,\%f,$cdom,$cnum); return $reply if ($reply ne 'ok'); $reply = &Apache::lonnet::put($stype.'_spreadsheets', {$fn => $ENV{'user.name'}.'@'.$ENV{'user.domain'}}, $cdom,$cnum); return $reply if ($reply ne 'ok'); if ($makedef) { $reply = &Apache::lonnet::put('environment', {'spreadsheet_default_'.$stype => $fn }, $cdom,$cnum); return $reply if ($reply ne 'ok'); } if ($self->is_default()) { &Apache::lonnet::expirespread('','',$self->{'type'},''); } return $reply; } return 'unauthorized'; } } # end of scope for %spreadsheets sub save_tmp { my $self = shift; my $fn=$ENV{'user.name'}.'_'. $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'. $self->{'filename'}; $fn=~s/\W/\_/g; $fn=$Apache::lonnet::tmpdir.$fn.'.tmp'; $self->temporary(1); my $fh; if ($fh=Apache::File->new('>'.$fn)) { my %f = $self->formulas(); while( my ($cell,$formula) = each(%f)) { next if ($formula eq 'import'); print $fh &Apache::lonnet::escape($cell)."=". &Apache::lonnet::escape($formula)."\n"; } $fh->close(); } } sub load_tmp { my $self = shift; my $filename=$ENV{'user.name'}.'_'. $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'. $self->{'filename'}; $filename=~s/\W/\_/g; $filename=$Apache::lonnet::tmpdir.$filename.'.tmp'; my %formulas = (); if (my $spreadsheet_file = Apache::File->new($filename)) { while (<$spreadsheet_file>) { chomp; my ($cell,$formula) = split(/=/); $cell = &Apache::lonnet::unescape($cell); $formula = &Apache::lonnet::unescape($formula); $formulas{$cell} = $formula; } $spreadsheet_file->close(); } # flag the sheet as temporary $self->temporary(1); $self->formulas(\%formulas); $self->set_row_sources(); $self->set_row_numbers(); return; } sub temporary { my $self=shift; if (@_) { ($self->{'temporary'})= @_; } $self->logthis('temporary = '.$self->{'temporary'}); return $self->{'temporary'}; } sub modify_cell { # studentcalc overrides this my $self = shift; my ($cell,$formula) = @_; if ($cell =~ /([A-z])\-/) { $cell = 'template_'.$1; } elsif ($cell !~ /^([A-z](\d+)|template_[A-z])$/) { return; } $self->set_formula($cell,$formula); $self->rebuild_stats(); return; } ########################################### # othersheets: Returns the list of other spreadsheets available ########################################### sub othersheets { my $self = shift(); my ($stype) = @_; $stype = $self->{'type'} if (! defined($stype) || $stype !~ /calc$/); # my @alternatives=(); my %results=&Apache::lonnet::dump($stype.'_spreadsheets', $self->{'cdom'}, $self->{'cnum'}); my ($tmp) = keys(%results); if ($tmp =~ /^(con_lost|error|no_such_host)/i ) { @alternatives = ('Default'); } else { @alternatives = sort (keys(%results)); } return @alternatives; } sub blackout { my $self = shift; $self->{'blackout'} = $_[0] if (@_); return $self->{'blackout'}; } sub get_row { my $self = shift; my ($n)=@_; my @cols=(); foreach my $col (@UC_Columns,@LC_Columns) { my $cell = $col.$n; push(@cols,{ name => $cell, formula => $self->formula($cell), value => $self->value($cell)}); } return @cols; } sub get_template_row { my $self = shift; my @cols=(); foreach my $col (@UC_Columns,@LC_Columns) { my $cell = 'template_'.$col; push(@cols,{ name => $cell, formula => $self->formula($cell), value => $self->formula($cell) }); } return @cols; } sub set_row_numbers { my $self = shift; my %f=$self->formulas(); while (my ($cell,$value) = each(%{$self->{'formulas'}})) { next if ($cell !~ /^A(\d+)$/); next if (! defined($value)); $self->{'row_numbers'}->{$value} = $1; } } sub get_row_number_from_key { my $self = shift; my ($key) = @_; if (! exists($self->{'row_numbers'}->{$key}) || ! defined($self->{'row_numbers'}->{$key})) { # I used to set $f here to the new value, but the key passed for lookup # may not be the key we need to save $self->{'maxrow'}++; $self->{'row_numbers'}->{$key} = $self->{'maxrow'}; } return $self->{'row_numbers'}->{$key}; } 1; __END__