--- loncom/interface/spreadsheet/Spreadsheet.pm 2003/11/11 14:17:20 1.29 +++ loncom/interface/spreadsheet/Spreadsheet.pm 2008/03/12 02:45:27 1.78 @@ -1,5 +1,5 @@ # -# $Id: Spreadsheet.pm,v 1.29 2003/11/11 14:17:20 matthew Exp $ +# $Id: Spreadsheet.pm,v 1.78 2008/03/12 02:45:27 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -60,6 +60,9 @@ use HTML::TokeParser; use Spreadsheet::WriteExcel; use Time::HiRes; use Apache::lonlocal; +use lib '/home/httpd/lib/perl/'; +use LONCAPA; + ## ## Package Variables @@ -85,25 +88,46 @@ sub new { my $class = ref($this) || $this; my ($stype) = ($class =~ /Apache::(.*)$/); # - my ($name,$domain,$filename,$usymb)=@_; + my ($name,$domain,$filename,$usymb,$section,$groups)=@_; + 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'}; + } + if (! defined($section) || $section eq '') { + $section = &Apache::lonnet::getsection($domain,$name, + $env{'request.course.id'}); + } + if (! defined($groups)) { + + my @usersgroups = &Apache::lonnet::get_users_groups($domain,$name, + $env{'request.course.id'}); + $groups = \@usersgroups; + } # my $self = { name => $name, domain => $domain, + section => $section, + groups => $groups, type => $stype, symb => $usymb, errorlog => '', maxrow => 0, - cid => $ENV{'request.course.id'}, - cnum => $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, - cdom => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - chome => $ENV{'course.'.$ENV{'request.course.id'}.'.home'}, - coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'}, - coursefilename => $ENV{'request.course.fn'}, + 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 + 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. @@ -117,18 +141,9 @@ sub new { 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; } @@ -151,21 +166,26 @@ sub filename { $newfilename !~ /\w/ || $newfilename eq '') { my $key = 'course.'.$self->{'cid'}.'.spreadsheet_default_'. $self->{'type'}; - if (exists($ENV{$key}) && $ENV{$key} ne '') { - $newfilename = $ENV{$key}; + 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'}; - } - } + if ($newfilename eq &mt('LON-CAPA Standard')) { + undef($newfilename); + } else { + 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; } @@ -190,6 +210,8 @@ sub make_default { {'spreadsheet_default_'.$self->{'type'} => $self->filename()}, $self->{'cdom'},$self->{'cnum'}); return $result if ($result ne 'ok'); + &Apache::lonnet::appenv({'course.'.$self->{'cid'}.'.spreadsheet_default_'. + $self->{'type'} => $self->filename()}); my $symb = $self->{'symb'}; $symb = '' if (! defined($symb)); &Apache::lonnet::expirespread('','',$self->{'type'},$symb); @@ -210,16 +232,8 @@ course environment. Returns 0 otherwise 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'}}; - } + my $default_filename = $env{'course.'.$self->{'cid'}. + '.spreadsheet_default_'.$self->{'type'}}; if ($default_filename =~ /^\s*$/) { $default_filename = 'default_'.$self->{'type'}; } @@ -249,10 +263,10 @@ sub initialize_spreadsheet_package { sub load_spreadsheet_expirationdates { undef %expiredates; - my $cid=$ENV{'request.course.id'}; + my $cid=$env{'request.course.id'}; my @tmp = &Apache::lonnet::dump('nohist_expirationdates', - $ENV{'course.'.$cid.'.domain'}, - $ENV{'course.'.$cid.'.num'}); + $env{'course.'.$cid.'.domain'}, + $env{'course.'.$cid.'.num'}); if (lc($tmp[0]) !~ /^error/){ %expiredates = @tmp; } @@ -306,6 +320,9 @@ Returns the safe space required by a Spr 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; @@ -313,9 +330,14 @@ sub initialize_safe_space { $safeeval->permit(":base_math"); $safeeval->permit("sort"); $safeeval->deny(":base_io"); - $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); + $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 # @@ -325,12 +347,9 @@ sub initialize_safe_space { # 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 %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 @@ -351,12 +370,10 @@ $filename = ''; # # user data $name = ''; -$uhome = ''; $domain = ''; # # course data $csec = ''; -$chome= ''; $cnum = ''; $cdom = ''; $cid = ''; @@ -372,6 +389,27 @@ $errormsg = ''; =pod +=item EXT(parameter) + +Calls the system EXT function to determine the value of the given parameter. + +=cut + +#------------------------------------------------------- +sub EXT { + my ($parameter,$specific_symb) = @_; + return '' if (! defined($parameter) || $parameter eq ''); + $parameter =~ s/^parameter\./resource\./; + if ($specific_symb eq '') { $specific_symb = $symb; } + my $value = &Apache::lonnet::EXT($parameter,$specific_symb,$domain,$name, + $usection); + return $value; +} + +#------------------------------------------------------- + +=pod + =item NUM(range) returns the number of items in the range. @@ -380,8 +418,8 @@ returns the number of items in the range #------------------------------------------------------- sub NUM { - my $mask=&mask(@_); - my $num= $#{@{grep(eval("/$mask/"),keys(%sheet_values))}}+1; + my $values=&get_values(@_); + my $num= scalar(@$values); return $num; } @@ -396,10 +434,10 @@ sub NUM { #------------------------------------------------------- sub BIN { my ($low,$high,$lower,$upper)=@_; - my $mask=&mask($lower,$upper); + my $values=&get_values($lower,$upper); my $num=0; - foreach (grep eval("/$mask/"),keys(%sheet_values)) { - if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) { + foreach (@$values) { + if (($_>=$low) && ($_<=$high)) { $num++; } } @@ -418,10 +456,10 @@ returns the sum of items in the range. #------------------------------------------------------- sub SUM { - my $mask=&mask(@_); + my $values=&get_values(@_); my $sum=0; - foreach (grep eval("/$mask/"),keys(%sheet_values)) { - $sum+=$sheet_values{$_}; + foreach (@$values) { + $sum+=$_; } return $sum; } @@ -438,11 +476,11 @@ compute the average of the items in the #------------------------------------------------------- sub MEAN { - my $mask=&mask(@_); + my $values=&get_values(@_); my $sum=0; my $num=0; - foreach (grep eval("/$mask/"),keys(%sheet_values)) { - $sum+=$sheet_values{$_}; + foreach (@$values) { + $sum+=$_; $num++; } if ($num) { @@ -464,17 +502,17 @@ compute the standard deviation of the it #------------------------------------------------------- sub STDDEV { - my $mask=&mask(@_); + my $values=&get_values(@_); my $sum=0; my $num=0; - foreach (grep eval("/$mask/"),keys(%sheet_values)) { - $sum+=$sheet_values{$_}; + foreach (@$values) { + $sum+=$_; $num++; } unless ($num>1) { return undef; } my $mean=$sum/$num; $sum=0; - foreach (grep eval("/$mask/"),keys(%sheet_values)) { - $sum+=($sheet_values{$_}-$mean)**2; + foreach (@$values) { + $sum+=($_-$mean)**2; } return sqrt($sum/($num-1)); } @@ -491,10 +529,10 @@ compute the product of the items in the #------------------------------------------------------- sub PROD { - my $mask=&mask(@_); + my $values=&get_values(@_); my $prod=1; - foreach (grep eval("/$mask/"),keys(%sheet_values)) { - $prod*=$sheet_values{$_}; + foreach (@$values) { + $prod*=$_; } return $prod; } @@ -511,12 +549,11 @@ compute the maximum of the items in the #------------------------------------------------------- sub MAX { - my $mask=&mask(@_); + my $values=&get_values(@_); my $max='-'; - foreach (grep eval("/$mask/"),keys(%sheet_values)) { - unless ($max) { $max=$sheet_values{$_}; } - if (($sheet_values{$_}>$max) || ($max eq '-')) { - $max=$sheet_values{$_}; + foreach (@$values) { + if (($_>$max) || ($max eq '-')) { + $max=$_; } } return $max; @@ -534,12 +571,11 @@ compute the minimum of the items in the #------------------------------------------------------- sub MIN { - my $mask=&mask(@_); + my $values=&get_values(@_); my $min='-'; - foreach (grep eval("/$mask/"),keys(%sheet_values)) { - unless ($max) { $max=$sheet_values{$_}; } - if (($sheet_values{$_}<$min) || ($min eq '-')) { - $min=$sheet_values{$_}; + foreach (@$values) { + if (($_<$min) || ($min eq '-')) { + $min=$_; } } return $min; @@ -559,12 +595,8 @@ compute the sum of the largest 'num' ite #------------------------------------------------------- sub SUMMAX { my ($num,$lower,$upper)=@_; - my $mask=&mask($lower,$upper); - my @inside=(); - foreach (grep eval("/$mask/"),keys(%sheet_values)) { - push (@inside,$sheet_values{$_}); - } - @inside=sort(@inside); + 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]; @@ -586,12 +618,8 @@ compute the sum of the smallest 'num' it #------------------------------------------------------- sub SUMMIN { my ($num,$lower,$upper)=@_; - my $mask=&mask($lower,$upper); - my @inside=(); - foreach (grep eval("/$mask/"),keys(%sheet_values)) { - $inside[$#inside+1]=$sheet_values{$_}; - } - @inside=sort(@inside); + 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]; @@ -614,7 +642,6 @@ parametername should be a string such as sub MINPARM { my ($expression) = @_; my $min = undef; - study($expression); foreach $parameter (keys(%c)) { next if ($parameter !~ /$expression/); if ((! defined($min)) || ($min > $c{$parameter})) { @@ -639,7 +666,6 @@ parametername should be a string such as sub MAXPARM { my ($expression) = @_; my $max = undef; - study($expression); foreach $parameter (keys(%c)) { next if ($parameter !~ /$expression/); if ((! defined($min)) || ($max < $c{$parameter})) { @@ -650,8 +676,79 @@ sub MAXPARM { } +=pod + +=item PARM(parametername) + +Returns the value of the parameter matching the input parameter name. +parametername should be a string such as 'parameter_1_opendate'. + +=cut + +#------------------------------------------------------- +sub PARM { + return $c{$_[0]}; +} + +#------------------------------------------------------- + +=pod + +=item &get_values($lower,$upper) + +Inputs: $lower and $upper, cell names ("X12" or "a150") or globs ("X*"). + +Returns: an array ref of the values of the cells that exist in the + speced range + +=cut + +#------------------------------------------------------- +sub get_values { + my ($lower,$upper)=@_; + $upper = $lower if (! defined($upper)); + my @values; + my ($la,$ld) = ($lower=~/([A-z]|\*)(\d+|\*)/); + my ($ua,$ud) = ($upper=~/([A-z]|\*)(\d+|\*)/); + my ($alpha,$num); + if ($ld ne '*' && $ud ne '*') { + my @alpha; + if (($la eq '*') || ($ua eq '*')) { + @alpha=('A'..'z'); + } else { + if ($la gt $ua) { ($la,$ua)=($ua,$la); } + if ((lc($la) ne $la) && (lc($ua) eq $ua)) { + @alpha=($la..'Z','a'..$ua); + } else { + @alpha=($la..$ua); + } + } + my @num=($ld..$ud); + foreach my $a (@alpha) { + foreach my $n (@num) { + if (exists($sheet_values{$a.$n})) { + push(@values,$sheet_values{$a.$n}); + } + } + } + return \@values; + } else { + $num = '([1-9]\d*)'; + } + if (($la eq '*') || ($ua eq '*')) { + $alpha='[A-z]'; + } else { + if ($la gt $ua) { ($la,$ua)=($ua,$la); } + $alpha=qq/[$la-$ua]/; + } + my $expression = '^'.$alpha.$num.'$'; + foreach (grep /$expression/,keys(%sheet_values)) { + push(@values,$sheet_values{$_}); + } + return \@values; +} + sub calc { - %sheet_values = %t; my $notfinished = 1; my $lastcalc = ''; my $depth = 0; @@ -678,7 +775,7 @@ sub calc { return $lastcalc.': Maximum calculation depth exceeded'; } } - return ''; + return 'okay'; } # ------------------------------------------- End of "Inside of the safe space" @@ -691,10 +788,11 @@ ENDDEFS # 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/) { + foreach (qw/name domain type symb cid csec coursefilename + cnum cdom/) { $initstring.= qq{\$$_="$self->{$_}";}; } + $initstring.=qq{\$usection="$usection";}; $self->{'safe'}->reval($initstring); return $self; } @@ -711,92 +809,6 @@ ENDDEFS ###################################################### - -###################################################### - -=pod - -=item &mask($lower,$upper) - -Inputs: $lower and $upper, cell names ("X12" or "a150") or globs ("X*"). - -Returns: Regular expression matching spreadsheet cells that are within -the rectangle defined by $lower and $upper. Due to the nature of the -regular expression this result must be used inside an eval(). - -=cut - -###################################################### -{ - -my %memoizer; - -sub mask { - my ($lower,$upper)=@_; - my $key = $lower.'_'.$upper; - if (exists($memoizer{$key})) { - return $memoizer{$key}; - } - $upper = $lower if (! defined($upper)); - # - my ($la,$ld) = ($lower=~/([A-z]|\*)(\d+|\*)/); - my ($ua,$ud) = ($upper=~/([A-z]|\*)(\d+|\*)/); - # - my $alpha=''; - my $num=''; - # - # Do not put parenthases around $alpha. - # $num depends on the value in $1. - if (($la eq '*') || ($ua eq '*')) { - $alpha='[A-z]'; - } else { - if ($la gt $ua) { - my $tmp = $ua; - $ua = $la; - $la = $ua; - } - $alpha=qq/[$la-$ua]/; - } - if ($ld ne '*' && $ud ne '*') { - # Make sure $ld <= $ud - if ($ld > $ud) { - my $tmp = $ud; - $ud = $ld; - $ld = $tmp; - } - # Here we make a regular expression using some advanced regexp - # abilities. - # (\d+) will match the digits of the cell name and dump them in - # to $1 - # (?(?{ ... code ...} pattern_if_true | pattern_if_false)) will - # choose pattern_if_true if { ... code ... } is true and - # pattern_if_false if { ... code ... } is false. - # In this case, pattern_if_true is empty. pattern_if_false is - # 'donotmatch' and will not match our cells because none of - # them end with donotmatch. - # Unfortunately, the use of this type of regular expression - # requires that each match be wrapped in an eval(). Search for - # $mask in this module for examples - $num = '(\d+)(?(?{$1>= '.$ld.' && $1<='.$ud.'})|donotmatch)'; - } else { - $num = '(\d+)'; - } - my $expression = '^'.$alpha.$num.'$'; - $memoizer{$key} = $expression; - return $expression; -} - -# -# Debugging routine -sub dump_memoized_values { - while (my ($key,$value) = each(%memoizer)) { - &Apache::lonnet::logthis('memoizer: '.$key.' = '.$value); - } - return; -} - -} - ## ## sub add_hash_to_safe {} # spreadsheet, would like to destroy ## @@ -808,18 +820,20 @@ sub expandnamed { my $self = shift; my $expression=shift; if ($expression=~/^\&/) { - my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/); + my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/s); my @vars=split(/\W+/,$formula); + # make the list uniq + @vars = keys(%{{ map { $_ => 1 } @vars }}); 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; - } - } + $varname=~s/$var/\([\\w:\\- ]\+\)/g; + foreach (keys(%{$self->{'constants'}})) { + if ($_=~/$varname/) { + $values{$1}=1; + } + } } } if ($func eq 'EXPANDSUM') { @@ -830,7 +844,7 @@ sub expandnamed { $result.=$thissum.'+'; } $result=~s/\+$//; - return $result; + return '('.$result.')'; } else { return 0; } @@ -845,7 +859,6 @@ sub expandnamed { my @matches = (); my @values = (); $#matches = -1; - study $expression; while (my($parameter,$value) = each(%{$self->{'constants'}})) { next if ($parameter !~ /$expression/); push(@matches,$parameter); @@ -877,6 +890,7 @@ sub expandnamed { sub sett { my $self = shift; my %t=(); + undef(%Apache::Spreadsheet::sheet_values); # # Deal with the template row foreach my $col ($self->template_cells()) { @@ -893,7 +907,7 @@ sub sett { # 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; + $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/sge; } } # @@ -905,17 +919,18 @@ sub sett { $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; + $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/sge; } elsif ( $col =~ /^[A-Z]$/ ) { - if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell})) { - my $data = $self->{'constants'}->{$cell}; - $t{$cell} = $data; + 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; + $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/sge; } } %{$self->{'safe'}->varglob('t')}=%t; @@ -928,11 +943,11 @@ sub sett { 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'}}; + #%{$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'}}; + #@{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}}; } ## @@ -985,15 +1000,32 @@ sub formulas { $self->{'formulas'} = $formulas; $self->{'rows'} = []; $self->{'template_cells'} = []; + $self->{'loaded'} = 1; return; } else { + $self->check_formulas_loaded(); return %{$self->{'formulas'}}; } } +sub check_formulas_loaded { + my $self=shift; + if (!$self->{'loaded'}) { + $self->{'loaded'}=1; + # Load in the spreadsheet definition + if (exists($env{'form.workcopy'}) && + $self->{'type'} eq $env{'form.workcopy'}) { + $self->load_tmp(); + } else { + $self->load(); + } + } +} + sub set_formula { my $self = shift; my ($cell,$formula) = @_; + $self->check_formulas_loaded(); $self->{'formulas'}->{$cell}=$formula; return; } @@ -1003,7 +1035,7 @@ sub set_formula { ## sub formulas_keys { my $self = shift; - my @keys = keys(%{$self->{'formulas'}}); + $self->check_formulas_loaded(); return keys(%{$self->{'formulas'}}); } @@ -1014,6 +1046,7 @@ sub formulas_keys { sub formula { my $self = shift; my $cell = shift; + $self->check_formulas_loaded(); if (defined($cell) && exists($self->{'formulas'}->{$cell})) { return $self->{'formulas'}->{$cell}; } @@ -1092,6 +1125,7 @@ sub rebuild_stats { my $self = shift; $self->{'rows'}=[]; $self->{'template_cells'}=[]; + $self->check_formulas_loaded(); 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+)/); @@ -1139,9 +1173,49 @@ sub calcsheet { # $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 @@ -1150,17 +1224,35 @@ sub calcsheet { 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'}; + foreach ($self->output_options()) { + if ($env{'form.output_format'} eq $_->{'value'}) { + $outputmode = $_->{'value'}; + last; + } } + $self->{outputmode} = $outputmode; 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 'source') { + # No computation necessary. Rumor has it that this is some + # sort of kludge w.r.t. not "computing". It's also + # a bit of of a kludge that we call "outsheet_html" and + # let the 'outputmode' cause the outputting of source. $self->outsheet_html($r); } elsif ($outputmode eq 'excel') { + $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; @@ -1169,20 +1261,34 @@ sub display { ############################################ ## 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 $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).''; + &html_editable_cell($cell,$color,$allowed, + $self->{outputmode} eq 'source').''; } else { $row_html .= ''. - &html_editable_cell($cell,'#DDCCFF',$allowed).''; + &html_editable_cell($cell,'#DDCCFF',$allowed, + $self->{outputmode} eq 'source').''; } } return $row_html; @@ -1190,7 +1296,7 @@ sub html_export_row { sub html_template_row { my $self = shift(); - my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); + my $allowed = &Apache::lonnet::allowed('mgr',$env{'request.course.id'}); my ($num_uneditable,$importcolor) = @_; my $row_html; my @rowdata = $self->get_template_row(); @@ -1201,15 +1307,16 @@ sub html_template_row { $row_html .= ''. &html_uneditable_cell($cell,'#FFDDDD',$allowed).''; } else { - $row_html .= ''. - &html_editable_cell($cell,'#EOFFDD',$allowed).''; + $row_html .= ''. + &html_editable_cell($cell,'#E0FFDD',$allowed, + $self->{outputmode} eq 'source').''; } } return $row_html; } sub html_editable_cell { - my ($cell,$bgcolor,$allowed) = @_; + my ($cell,$bgcolor,$allowed,$showsource) = @_; my $result; my ($name,$formula,$value); if (defined($cell)) { @@ -1219,7 +1326,13 @@ sub html_editable_cell { } $name = '' if (! defined($name)); $formula = '' if (! defined($formula)); - if (! defined($value)) { + if ($showsource) { + if (!defined($formula) || $formula =~ /^\s*$/) { + $value = '#'; + } else { + $value = &HTML::Entities::encode($formula, '<>&"'); + } + } elsif (! defined($value)) { $value = '#'; if ($formula ne '') { $value = 'undefined value'; @@ -1227,7 +1340,7 @@ sub html_editable_cell { } elsif ($value =~ /^\s*$/ ) { $value = '#'; } else { - $value = &HTML::Entities::encode($value) if ($value !~/ /); + $value = &HTML::Entities::encode($value,'<>&"') if ($value !~/ /); } return $value if (! $allowed); # @@ -1250,14 +1363,14 @@ sub html_editable_cell { sub html_uneditable_cell { my ($cell,$bgcolor) = @_; my $value = (defined($cell) ? $cell->{'value'} : ''); - $value = &HTML::Entities::encode($value) if ($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 $allowed = &Apache::lonnet::allowed('mgr',$env{'request.course.id'}); my @rowdata = $self->get_row($row); my $num_cols_output = 0; my $row_html; @@ -1271,8 +1384,9 @@ sub html_row { $row_html .= ''; $row_html .= &html_uneditable_cell($cell,'#FFDDDD'); } else { - $row_html .= ''; - $row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed); + $row_html .= ''; + $row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed, + $self->{outputmode} eq 'source'); } $row_html .= ''; } @@ -1281,30 +1395,44 @@ sub html_row { sub html_header { my $self = shift; - return '' if (! $ENV{'request.role.adv'}); + return '' if (! $env{'request.role.adv'}); return "\n". ''."\n". - '\n". + '\n". "
'.&mt('Output Format').'
'.&output_selector()."
'.$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 => 'source', + description => 'Show Source'}, +# {value => 'xml', +# description => 'XML'}, + {value => 'csv', + description => 'Comma Separated Values'},); +} + sub output_selector { + my $self = shift(); my $output_selector = '\n"; return $output_selector; @@ -1328,39 +1456,28 @@ sub excel_output_row { return; } -sub create_excel_spreadsheet { +# +# This routine is just a stub +sub outsheet_htmlclasslist { 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(&mt("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); + $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 worksheet - my ($workbook,$filename) = $self->create_excel_spreadsheet($r); + # Create excel workbook + my ($workbook,$filename,$format)=&Apache::loncommon::create_workbook($r); return if (! defined($workbook)); # # Create main worksheet @@ -1371,16 +1488,18 @@ sub outsheet_excel { # Write excel header foreach my $value ($self->get_title()) { $cols_output = 0; - $worksheet->write($rows_output++,$cols_output,$value); + $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'); + $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); + $self->excel_rows($connection,$worksheet,$cols_output,$rows_output, + $format); # # # Close the excel file @@ -1399,12 +1518,16 @@ 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'}.'_'. + $env{'user.name'}.'_'.$env{'user.domain'}.'_'. time.'_'.rand(1000000000).'.csv'; my $file; unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) { @@ -1462,18 +1585,22 @@ sub outsheet_xml { ## Will be rendered for the user ## But not on this day my $Str = ''."\n"; + $self->check_formulas_loaded(); while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { - if ($cell =~ /^template_(\d+)/) { + if ($cell =~ /^template_(\w+)/) { my $col = $1; $Str .= ''."\n"; } else { - my ($row,$col) = ($cell =~ /^([A-z])(\d+)/); + my ($col,$row) = ($cell =~ /^([A-z])(\d+)/); next if (! defined($row) || ! defined($col)); - $Str .= ''.$formula.'' + next if ($row != 0); + $Str .= + ''.$formula.'' ."\n"; } } $Str.=""; + $r->print("
\n\n\n".$Str."\n\n\n
"); return $Str; } @@ -1500,8 +1627,7 @@ sub parse_sheet { $formulas{$cell} = $formula; $sources{$cell} = $source if (defined($source)); $parser->get_text('/field'); - } - if ($token->[1] eq 'template') { + } elsif ($token->[1] eq 'template') { $formulas{'template_'.$token->[2]->{'col'}}= $parser->get_text('/template'); } @@ -1542,7 +1668,6 @@ sub load { 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)); @@ -1551,11 +1676,15 @@ sub load { my ($formulas); if (exists($spreadsheets{$cachekey})) { $formulas = $spreadsheets{$cachekey}->{'formulas'}; + $self->formulas($formulas); + $self->{'row_source'}=$spreadsheets{$cachekey}->{'row_source'}; + $self->{'row_numbers'}=$spreadsheets{$cachekey}->{'row_numbers'}; + $self->{'maxrow'}=$spreadsheets{$cachekey}->{'maxrow'}; } else { # Not cached, need to read if (! defined($filename)) { $formulas = $self->load_system_default_sheet(); - } elsif($self->filename() =~ /^\/res\/.*\.spreadsheet$/) { + } elsif($filename =~ /^\/res\/.*\.spreadsheet$/) { # Load a spreadsheet definition file my $sheetxml=&Apache::lonnet::getfile (&Apache::lonnet::filelocation('',$filename)); @@ -1576,7 +1705,8 @@ sub load { # 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) { + if (%tmphash + && $tmp !~ /^(con_lost|error|no_such_host)/i) { while (my ($cell,$formula) = each(%tmphash)) { $formulas->{$cell}=$formula; } @@ -1584,17 +1714,38 @@ sub load { $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(); + $self->cache_sheet($formulas); } - $self->formulas($formulas); - $self->set_row_sources(); - $self->set_row_numbers(); +} + +sub cache_sheet { + my $self = shift; + my ($formulas) = @_; + my $stype = $self->{'type'}; + my $cnum = $self->{'cnum'}; + my $cdom = $self->{'cdom'}; + # + my $filename = $self->filename(); + my $cachekey = join('_',($cnum,$cdom,$stype,$filename)); + + if (ref($formulas) eq 'HASH') { + %{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas}; + } + if (ref($self->{'row_source'})) { + %{$spreadsheets{$cachekey}->{'row_source'}} =%{$self->{'row_source'}}; + } + if (ref($self->{'row_numbers'})) { + %{$spreadsheets{$cachekey}->{'row_numbers'}}=%{$self->{'row_numbers'}}; + } + $spreadsheets{$cachekey}->{'maxrow'} = $self->{'maxrow'}; } sub set_row_sources { my $self = shift; + $self->check_formulas_loaded(); while (my ($cell,$value) = each(%{$self->{'formulas'}})) { next if ($cell !~ /^A(\d+)/ || $1 < 1); my $row = $1; @@ -1605,6 +1756,7 @@ sub set_row_sources { sub set_row_numbers { my $self = shift; + $self->check_formulas_loaded(); while (my ($cell,$value) = each(%{$self->{'formulas'}})) { next if ($cell !~ /^A(\d+)$/); next if (! defined($value)); @@ -1618,6 +1770,9 @@ sub set_row_numbers { ## 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')); @@ -1636,11 +1791,9 @@ sub save { 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; + $self->cache_sheet(\%f); # Write sheet foreach (keys(%f)) { delete($f{$_}) if ($f{$_} eq 'import'); @@ -1648,7 +1801,7 @@ sub save { 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'}}, + {$filename => $env{'user.name'}.'@'.$env{'user.domain'}}, $cdom,$cnum); return $reply if ($reply ne 'ok'); if ($makedef) { @@ -1656,14 +1809,14 @@ sub save { {'spreadsheet_default_'.$stype => $filename }, $cdom,$cnum); return $reply if ($reply ne 'ok'); + &Apache::lonnet::appenv({'course.'.$self->{'cid'}.'.spreadsheet_default_'. + $self->{'type'} => $self->filename()}); } - if ($self->is_default()) { - if ($self->{'type'} eq 'studentcalc') { - &Apache::lonnet::expirespread('','','studentcalc',''); - } elsif ($self->{'type'} eq 'assesscalc') { - &Apache::lonnet::expirespread('','','assesscalc',''); - &Apache::lonnet::expirespread('','','studentcalc',''); - } + if ($self->{'type'} eq 'studentcalc') { + &Apache::lonnet::expirespread('','','studentcalc',''); + } elsif ($self->{'type'} eq 'assesscalc') { + &Apache::lonnet::expirespread('','','assesscalc',''); + &Apache::lonnet::expirespread('','','studentcalc',''); } return $reply; } @@ -1674,8 +1827,8 @@ sub save { sub save_tmp { my $self = shift; - my $filename=$ENV{'user.name'}.'_'. - $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'. + my $filename=$env{'user.name'}.'_'. + $env{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'. $self->{'filename'}; $filename=~s/\W/\_/g; $filename=$Apache::lonnet::tmpdir.$filename.'.tmp'; @@ -1685,8 +1838,8 @@ sub save_tmp { 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"; + print $fh &escape($cell)."=". + &escape($formula)."\n"; } $fh->close(); } @@ -1694,8 +1847,8 @@ sub save_tmp { sub load_tmp { my $self = shift; - my $filename=$ENV{'user.name'}.'_'. - $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'. + my $filename=$env{'user.name'}.'_'. + $env{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'. $self->{'filename'}; $filename=~s/\W/\_/g; $filename=$Apache::lonnet::tmpdir.$filename.'.tmp'; @@ -1704,8 +1857,8 @@ sub load_tmp { while (<$spreadsheet_file>) { chomp; my ($cell,$formula) = split(/=/); - $cell = &Apache::lonnet::unescape($cell); - $formula = &Apache::lonnet::unescape($formula); + $cell = &unescape($cell); + $formula = &unescape($formula); $formulas{$cell} = $formula; } $spreadsheet_file->close(); @@ -1748,14 +1901,13 @@ sub othersheets { my ($stype) = @_; $stype = $self->{'type'} if (! defined($stype) || $stype !~ /calc$/); # - my @alternatives=(); + my @alternatives=(&mt('Default'), &mt('LON-CAPA Standard')); my %results=&Apache::lonnet::dump($stype.'_spreadsheets', $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))); + if (%results + && $tmp !~ /^(con_lost|error|no_such_host)/i ) { + push(@alternatives, sort(keys(%results))); } return @alternatives; }