loncom/interface/spreadsheet/Spreadsheet.pm - view

File: [LON-CAPA] / loncom / interface / spreadsheet / Spreadsheet.pm
Revision 1.15: download - view: text, annotated - select for diffs
Wed Jun 18 19:09:23 2003 UTC (20 years, 11 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Remove unused code.  When the system tries to compute a spreadsheet
we first try to load the sheet from the class' directory.  If the
sheet is not present we then load the system default for that level.
This allows the user to make changes to a spreadsheet and save it
with the same name as the system default (default_sheetlevel).

# # $Id: Spreadsheet.pm,v 1.15 2003/06/18 19:09:23 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'}, # # 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 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 = (); 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); } return; } ############################################ ## 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="#FFDDDD">'. &html_uneditable_cell($cell,'#FFDDDD',$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 html_header { my $self = shift; return '' if (! $ENV{'request.role.adv'}); return "<table>\n". '<tr><th align="center">Output Format</th><tr>'."\n". '<tr><td>'.&output_selector()."</td></tr>\n". "</table>\n"; } sub output_selector { my $output_selector = '<select name="output_format" size="3">'."\n"; my $default = 'html'; if (exists($ENV{'form.output_format'})) { $default = $ENV{'form.output_format'} } else { $ENV{'form.output_format'} = $default; } foreach (['html','HTML'], ['excel','Excel'], ['csv','Comma Seperated Values']) { my ($name,$description) = @{$_}; $output_selector.=qq{<option value="$name"}; if ($name eq $default) { $output_selector .= ' selected'; } $output_selector .= ">$description</option>\n"; } $output_selector .= "</select>\n"; return $output_selector; } ################################################ ## Excel output routines ## ################################################ sub excel_output_row { my $self = shift; my ($worksheet,$rownum,$rows_output,@prepend) = @_; my $cols_output = 0; # my @rowdata = $self->get_row($rownum); foreach my $cell (@prepend,@rowdata) { my $value = $cell; $value = $cell->{'value'} if (ref($value)); $value =~ s/\ / /gi; $worksheet->write($rows_output,$cols_output++,$value); } return; } 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); } sub outsheet_excel { my $self = shift; my ($r) = @_; $r->print("<h2>Preparing Excel Spreadsheet</h2>"); # # Create excel worksheet my ($workbook,$filename) = $self->create_excel_spreadsheet($r); return if (! defined($workbook)); # # Create main worksheet my $worksheet = $workbook->addworksheet('main'); my $rows_output = 0; my $cols_output = 0; # # Write excel header foreach my $value ($self->get_title()) { $cols_output = 0; $worksheet->write($rows_output++,$cols_output,$value); } $rows_output++; # skip a line # # Write summary/export row $cols_output = 0; $self->excel_output_row($worksheet,0,$rows_output++,'Summary'); $rows_output++; # skip a line # $self->excel_rows($worksheet,$cols_output,$rows_output); # # # Close the excel file $workbook->close(); # # Write a link to allow them to download it $r->print('<br />'. '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n"); return; } ################################# ## CSV output routines ## ################################# sub outsheet_csv { my $self = shift; my ($r) = @_; my $csvdata = ''; my @Values; # # Open the csv file my $filename = '/prtspool/'. $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. time.'_'.rand(1000000000).'.csv'; my $file; unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) { $r->log_error("Couldn't open $filename for output $!"); $r->print("Problems occured in writing the csv file. ". "This error has been logged. ". "Please alert your LON-CAPA administrator."); $r->print("<pre>\n".$csvdata."</pre>\n"); return 0; } # # Output the title information foreach my $value ($self->get_title()) { print $file "'".&Apache::loncommon::csv_translate($value)."'\n"; } # # Output the body of the spreadsheet $self->csv_rows($file); # # Close the csv file close($file); $r->print('<br /><br />'. '<a href="'.$filename.'">Your CSV spreadsheet.</a>'."\n"); # return 1; } sub csv_output_row { my $self = shift; my ($filehandle,$rownum,@prepend) = @_; # my @rowdata = (); if (defined($rownum)) { @rowdata = $self->get_row($rownum); } my @output = (); foreach my $cell (@prepend,@rowdata) { my $value = $cell; $value = $cell->{'value'} if (ref($value)); $value =~ s/\ / /gi; $value = "'".$value."'"; push (@output,$value); } print $filehandle join(',',@output )."\n"; return; } ############################################ ## 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_system_default_sheet { my $self = shift; my $includedir = $Apache::lonnet::perlvar{'lonIncludes'}; # load in the default defined spreadsheet my $sheetxml=''; my $fh; if ($fh=Apache::File->new($includedir.'/default_'.$self->{'type'})) { $sheetxml=join('',<$fh>); $fh->close(); } else { # $sheetxml='<field row="0" col="A">"Error"</field>'; $sheetxml='<field row="0" col="A"></field>'; } $self->filename('default_'); my ($formulas,undef) = &parse_sheet(\$sheetxml); return $formulas; } sub load { my $self = shift; # my $stype = $self->{'type'}; my $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($filename)) { $formulas = $self->load_system_default_sheet(); } elsif($self->filename() =~ /^\/res\/.*\.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); # Get just the filename and set the sheets filename my ($newfilename) = ($filename =~ /\/([^\/]*)\.spreadsheet$/); if ($self->is_default()) { $self->filename($newfilename); $self->make_default(); } else { $self->filename($newfilename); } } else { # Load the spreadsheet definition file from the save file my %tmphash = &Apache::lonnet::dump($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 { $formulas = $self->load_system_default_sheet(); } } $filename=$self->filename(); # filename may have changed $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; } sub set_row_numbers { my $self = shift; while (my ($cell,$value) = each(%{$self->{'formulas'}})) { next if ($cell !~ /^A(\d+)$/); next if (! defined($value)); $self->{'row_numbers'}->{$value} = $1; $self->{'maxrow'} = $1 if ($1 > $self->{'maxrow'}); } } ## ## exportrow is *not* used to get the export row from a computed sub-sheet. ## 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 $filename = $self->{'filename'}; my $cachekey = join('_',($cnum,$cdom,$stype,$filename)); # Cache new sheet %{$spreadsheets{$cachekey}->{'formulas'}}=%f; # Write sheet foreach (keys(%f)) { delete($f{$_}) if ($f{$_} eq 'import'); } my $reply = &Apache::lonnet::put($filename,\%f,$cdom,$cnum); return $reply if ($reply ne 'ok'); $reply = &Apache::lonnet::put($stype.'_spreadsheets', {$filename => $ENV{'user.name'}.'@'.$ENV{'user.domain'}}, $cdom,$cnum); return $reply if ($reply ne 'ok'); if ($makedef) { $reply = &Apache::lonnet::put('environment', {'spreadsheet_default_'.$stype => $filename }, $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 $filename=$ENV{'user.name'}.'_'. $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'. $self->{'filename'}; $filename=~s/\W/\_/g; $filename=$Apache::lonnet::tmpdir.$filename.'.tmp'; $self->temporary(1); my $fh; if ($fh=Apache::File->new('>'.$filename)) { 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'})= @_; } 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 = ('Default', 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 need_to_save { my $self = shift; if ($self->{'new_rows'} && ! $self->temporary()) { return 1; } return 0; } 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'}; # $self->logthis('added row '.$self->{'row_numbers'}->{$key}. # ' for '.$key); $self->{'new_rows'} = 1; } return $self->{'row_numbers'}->{$key}; } 1; __END__