# # $Id: Spreadsheet.pm,v 1.49 2005/05/15 04:49:42 albertel 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; use Apache::lonlocal; ## ## 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)=@_; if (defined($usymb) && ref($usymb)) { $usymb = $usymb->symb; } if (! defined($name) || $name eq '') { $name = $env{'user.name'}; } if (! defined($domain) || $domain eq '') { $domain = $env{'user.domain'}; } # my $self = { 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'}, 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 loaded => 0, # true if the formulas have been loaded # # 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 => [], }; # bless($self,$class); # 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'}$/ && $newfilename !~ /^\/res\/(.*)spreadsheet$/) { 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; my $usection = &Apache::lonnet::getsection($self->{'domain'}, $self->{'name'}, $env{'request.course.id'}); 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,'&Apache::lonnet::EXT'); $safehole->wrap(\&mask,$safeeval,'&mask'); $safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&logthis'); $safeeval->share('$@'); # Holds the (computed, final) values for the sheet # This is only written to by &calc, the spreadsheet computation routine. # It is read by many functions $safeeval->share('%sheet_values'); my $code=<<'ENDDEFS'; # ---------------------------------------------------- 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 %t; # Holds the forumlas of the spreadsheet to be computed. 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 = ''; $domain = ''; # # course data $csec = ''; $cnum = ''; $cdom = ''; $cid = ''; $coursefilename = ''; # # symb $usymb = ''; # # error messages $errormsg = ''; # #------------------------------------------------------- =pod =item EXT(parameter) Calls the system EXT function to determine the value of the given parameter. =cut #------------------------------------------------------- sub EXT { my ($parameter) = @_; return '' if (! defined($parameter) || $parameter eq ''); $parameter =~ s/^parameter\./resource\./; my $value = &Apache::lonnet::EXT($parameter,$symb,$domain,$name,$usection); return $value; } #------------------------------------------------------- =pod =item NUM(range) returns the number of items in the range. =cut #------------------------------------------------------- sub NUM { my $values=&get_values(@_); my $num= scalar(@$values); return $num; } #------------------------------------------------------- =pod =item BIN(low,high,lower,upper) =cut #------------------------------------------------------- sub BIN { my ($low,$high,$lower,$upper)=@_; my $values=&get_values($lower,$upper); my $num=0; foreach (@$values) { if (($_>=$low) && ($_<=$high)) { $num++; } } return $num; } #------------------------------------------------------- =pod =item SUM(range) returns the sum of items in the range. =cut #------------------------------------------------------- sub SUM { my $values=&get_values(@_); my $sum=0; foreach (@$values) { $sum+=$_; } return $sum; } #------------------------------------------------------- =pod =item MEAN(range) compute the average of the items in the range. =cut #------------------------------------------------------- sub MEAN { my $values=&get_values(@_); my $sum=0; my $num=0; foreach (@$values) { $sum+=$_; $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 $values=&get_values(@_); my $sum=0; my $num=0; foreach (@$values) { $sum+=$_; $num++; } unless ($num>1) { return undef; } my $mean=$sum/$num; $sum=0; foreach (@$values) { $sum+=($_-$mean)**2; } return sqrt($sum/($num-1)); } #------------------------------------------------------- =pod =item PROD(range) compute the product of the items in the range. =cut #------------------------------------------------------- sub PROD { my $values=&get_values(@_); my $prod=1; foreach (@$values) { $prod*=$_; } return $prod; } #------------------------------------------------------- =pod =item MAX(range) compute the maximum of the items in the range. =cut #------------------------------------------------------- sub MAX { my $values=&get_values(@_); my $max='-'; foreach (@$values) { if (($_>$max) || ($max eq '-')) { $max=$_; } } return $max; } #------------------------------------------------------- =pod =item MIN(range) compute the minimum of the items in the range. =cut #------------------------------------------------------- sub MIN { my $values=&get_values(@_); my $min='-'; foreach (@$values) { if (($_<$min) || ($min eq '-')) { $min=$_; } } 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 $values=&get_values($lower,$upper); my @inside=sort {$a <=> $b} (@$values); 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 $values=&get_values($lower,$upper); my @inside=sort {$a <=> $b} (@$values); 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; 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; foreach $parameter (keys(%c)) { next if ($parameter !~ /$expression/); if ((! defined($min)) || ($max < $c{$parameter})) { $max = $c{$parameter} } } return $max; } #------------------------------------------------------- =pod =item &get_values($lower,$upper) Inputs: $lower and $upper, cell names ("X12" or "a150") or globs ("X*"). Returns: an array ref of the values of the cells that exist in the speced range =cut #------------------------------------------------------- sub get_values { my ($lower,$upper)=@_; $upper = $lower if (! defined($upper)); my @values; my ($la,$ld) = ($lower=~/([A-z]|\*)(\d+|\*)/); my ($ua,$ud) = ($upper=~/([A-z]|\*)(\d+|\*)/); my ($alpha,$num); if ($ld ne '*' && $ud ne '*') { my @alpha; if (($la eq '*') || ($ua eq '*')) { @alpha=('A'..'z'); } else { if ($la gt $ua) { ($la,$ua)=($ua,$la); } if ((lc($la) ne $la) && (lc($ua) eq $ua)) { @alpha=($la..'Z','a'..$ua); } else { @alpha=($la..$ua); } } my @num=($ld..$ud); foreach my $a (@alpha) { foreach my $n (@num) { if (exists($sheet_values{$a.$n})) { push(@values,$sheet_values{$a.$n}); } } } return \@values; } else { $num = '(\d+)'; } if (($la eq '*') || ($ua eq '*')) { $alpha='[A-z]'; } else { if ($la gt $ua) { ($la,$ua)=($ua,$la); } $alpha=qq/[$la-$ua]/; } my $expression = '^'.$alpha.$num.'$'; foreach (grep /$expression/,keys(%sheet_values)) { push(@values,$sheet_values{$_}); } return \@values; } sub calc { 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 'okay'; } # ------------------------------------------- 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 symb cid csec coursefilename cnum cdom/) { $initstring.= qq{\$$_="$self->{$_}";}; } $initstring.=qq{\$usection="$usection";}; $self->{'safe'}->reval($initstring); return $self; } } ###################################################### =pod =back =cut ###################################################### ## ## 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; 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=(); undef(%Apache::Spreadsheet::sheet_values); # # 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}) && $self->{'constants'}->{$cell} ne '') { $Apache::Spreadsheet::sheet_values{$cell}= eval($self->{'constants'}->{$cell}); } } 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 { if (!$self->{'loaded'}) { $self->{'loaded'}=1; # 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->{'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()); if ($result ne 'okay') { $self->set_calcerror($result); } return $result; } sub set_badcalc { my $self = shift(); $self->{'badcalc'} =1; return; } sub badcalc { my $self = shift; if (exists($self->{'badcalc'}) && $self->{'badcalc'}) { return 1; } else { return 0; } } sub set_calcerror { my $self = shift; if (@_) { $self->set_badcalc(); if (exists($self->{'calcerror'})) { $self->{'calcerror'}.="\n".$_[0]; } else { $self->{'calcerror'}.=$_[0]; } } } sub calcerror { my $self = shift; if ($self->badcalc()) { if (exists($self->{'calcerror'})) { return $self->{'calcerror'}; } } return; } ########################################################### ## ## Output Helpers ## ########################################################### sub display { my $self = shift; my ($r) = @_; my $outputmode = 'html'; foreach ($self->output_options()) { if ($env{'form.output_format'} eq $_->{'value'}) { $outputmode = $_->{'value'}; last; } } if ($outputmode eq 'html') { $self->compute($r); $self->outsheet_html($r); } elsif ($outputmode eq 'htmlclasslist') { # No computation neccessary... This is kludgy $self->outsheet_htmlclasslist($r); } elsif ($outputmode eq 'excel') { $self->compute($r); $self->outsheet_excel($r); } elsif ($outputmode eq 'csv') { $self->compute($r); $self->outsheet_csv($r); } elsif ($outputmode eq 'xml') { # $self->compute($r); $self->outsheet_xml($r); } $self->cleanup(); return; } ############################################ ## HTML output routines ## ############################################ sub html_report_error { my $self = shift(); my $Str = ''; if ($self->badcalc()) { $Str = '

'. &mt('An error occurred while calculating this spreadsheet'). "

\n". '
'.$self->calcerror()."
\n"; } return $Str; } 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". "
'.&mt('Output Format').'
'.$self->output_selector()."
\n"; } ## ## Default output types are HTML, Excel, and CSV sub output_options { my $self = shift(); return ({value => 'html', description => 'HTML'}, {value => 'excel', description => 'Excel'}, # {value => 'xml', # description => 'XML'}, {value => 'csv', description => 'Comma Separated Values'},); } sub output_selector { my $self = shift(); my $output_selector = '\n"; return $output_selector; } ################################################ ## Excel output routines ## ################################################ sub excel_output_row { my $self = shift; my ($worksheet,$rownum,$rows_output,@prepend) = @_; my $cols_output = 0; # my @rowdata = $self->get_row($rownum); foreach my $cell (@prepend,@rowdata) { my $value = $cell; $value = $cell->{'value'} if (ref($value)); $value =~ s/\ / /gi; $worksheet->write($rows_output,$cols_output++,$value); } return; } # # This routine is just a stub sub outsheet_htmlclasslist { my $self = shift; my ($r) = @_; $r->print('

'.&mt("This output is not supported").'

'); $r->rflush(); return; } sub outsheet_excel { my $self = shift; my ($r) = @_; my $connection = $r->connection(); # $r->print($self->html_report_error()); $r->rflush(); # $r->print("

".&mt('Preparing Excel Spreadsheet')."

"); # # Create excel workbook my ($workbook,$filename,$format)=&Apache::loncommon::create_workbook($r); return if (! defined($workbook)); # # Create main worksheet my $worksheet = $workbook->addworksheet('main'); my $rows_output = 0; my $cols_output = 0; # # Write excel header foreach my $value ($self->get_title()) { $cols_output = 0; $worksheet->write($rows_output++,$cols_output,$value,$format->{'h1'}); } $rows_output++; # skip a line # # Write summary/export row $cols_output = 0; $self->excel_output_row($worksheet,0,$rows_output++,'Summary', $format->{'b'}); $rows_output++; # skip a line # $self->excel_rows($connection,$worksheet,$cols_output,$rows_output, $format); # # # Close the excel file $workbook->close(); # # Write a link to allow them to download it $r->print('
'. 'Your Excel spreadsheet.'."\n"); return; } ################################# ## CSV output routines ## ################################# sub outsheet_csv { my $self = shift; my ($r) = @_; my $connection = $r->connection(); # $r->print($self->html_report_error()); $r->rflush(); # my $csvdata = ''; my @Values; # # Open the csv file my $filename = '/prtspool/'. $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(&mt("Problems occured in writing the csv file. ". "This error has been logged. ". "Please alert your LON-CAPA administrator.")); $r->print("
\n".$csvdata."
\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($connection,$file); # # Close the csv file close($file); $r->print('

'. ''.&mt('Your CSV spreadsheet.').''."\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 = ''."\n"; while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { if ($cell =~ /^template_(\w+)/) { my $col = $1; $Str .= ''."\n"; } else { my ($col,$row) = ($cell =~ /^([A-z])(\d+)/); next if (! defined($row) || ! defined($col)); next if ($row != 0); $Str .= ''.$formula.'' ."\n"; } } $Str.=""; $r->print("
\n\n\n".$Str."\n\n\n
"); 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'); } elsif ($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='"Error"'; $sheetxml=''; } $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 $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($filename =~ /^\/res\/.*\.spreadsheet$/) { # Load a spreadsheet definition file my $sheetxml=&Apache::lonnet::getfile (&Apache::lonnet::filelocation('',$filename)); if ($sheetxml == -1) { $sheetxml='"Error loading spreadsheet ' .$self->filename().'"'; } ($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 < 1); 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; if (exists($self->{'badcalc'}) && $self->{'badcalc'}) { return (); } 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 $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()) { if ($self->{'type'} eq 'studentcalc') { &Apache::lonnet::expirespread('','','studentcalc',''); } elsif ($self->{'type'} eq 'assesscalc') { &Apache::lonnet::expirespread('','','assesscalc',''); &Apache::lonnet::expirespread('','','studentcalc',''); } } return $reply; } return 'unauthorized'; } } # end of scope for %spreadsheets sub save_tmp { my $self = shift; my $filename=$env{'user.name'}.'_'. $env{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'. $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->{'symb'}.'_'. $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 = (&mt('Default')); } else { @alternatives = (&mt('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__