--- loncom/interface/Attic/lonspreadsheet.pm 2002/02/04 10:30:58 1.80
+++ loncom/interface/Attic/lonspreadsheet.pm 2002/09/27 20:41:25 1.100.4.2
@@ -1,5 +1,5 @@
#
-# $Id: lonspreadsheet.pm,v 1.80 2002/02/04 10:30:58 matthew Exp $
+# $Id: lonspreadsheet.pm,v 1.100.4.2 2002/09/27 20:41:25 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -71,7 +71,7 @@ use Apache::lonnet;
use Apache::Constants qw(:common :http);
use GDBM_File;
use HTML::TokeParser;
-
+use Apache::lonhtmlcommon;
#
# Caches for previously calculated spreadsheets
#
@@ -106,6 +106,14 @@ my %courseopt;
my %useropt;
my %parmhash;
+#
+# Some hashes for stats on timing and performance
+#
+
+my %starttimes;
+my %usedtimes;
+my %numbertimes;
+
# Stuff that only the screen handler can know
my $includedir;
@@ -122,6 +130,7 @@ sub initsheet {
$safeeval->permit("sort");
$safeeval->deny(":base_io");
$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
+ $safeeval->share('$@');
my $code=<<'ENDDEFS';
# ---------------------------------------------------- Inside of the safe space
@@ -165,6 +174,10 @@ $cfn='';
$usymb='';
+# error messages
+
+$errormsg='';
+
sub mask {
my ($lower,$upper)=@_;
@@ -508,6 +521,15 @@ sub HASH {
return $Values[-1];
}
+#-------------------------------------------------------
+
+=item NUM(range)
+
+returns the number of items in the range.
+
+=cut
+
+#-------------------------------------------------------
sub NUM {
my $mask=mask(@_);
my $num= $#{@{grep(/$mask/,keys(%v))}}+1;
@@ -527,6 +549,15 @@ sub BIN {
}
+#-------------------------------------------------------
+
+=item SUM(range)
+
+returns the sum of items in the range.
+
+=cut
+
+#-------------------------------------------------------
sub SUM {
my $mask=mask(@_);
my $sum=0;
@@ -536,6 +567,15 @@ sub SUM {
return $sum;
}
+#-------------------------------------------------------
+
+=item MEAN(range)
+
+compute the average of the items in the range.
+
+=cut
+
+#-------------------------------------------------------
sub MEAN {
my $mask=mask(@_);
my $sum=0; my $num=0;
@@ -550,6 +590,15 @@ sub MEAN {
}
}
+#-------------------------------------------------------
+
+=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;
@@ -566,6 +615,15 @@ sub STDDEV {
return sqrt($sum/($num-1));
}
+#-------------------------------------------------------
+
+=item PROD(range)
+
+compute the product of the items in the range.
+
+=cut
+
+#-------------------------------------------------------
sub PROD {
my $mask=mask(@_);
my $prod=1;
@@ -575,6 +633,15 @@ sub PROD {
return $prod;
}
+#-------------------------------------------------------
+
+=item MAX(range)
+
+compute the maximum of the items in the range.
+
+=cut
+
+#-------------------------------------------------------
sub MAX {
my $mask=mask(@_);
my $max='-';
@@ -585,6 +652,15 @@ sub MAX {
return $max;
}
+#-------------------------------------------------------
+
+=item MIN(range)
+
+compute the minimum of the items in the range.
+
+=cut
+
+#-------------------------------------------------------
sub MIN {
my $mask=mask(@_);
my $min='-';
@@ -595,12 +671,22 @@ sub MIN {
return $min;
}
+#-------------------------------------------------------
+
+=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(%v)) {
- $inside[$#inside+1]=$v{$_};
+ push (@inside,$v{$_});
}
@inside=sort(@inside);
my $sum=0; my $i;
@@ -610,6 +696,16 @@ sub SUMMAX {
return $sum;
}
+#-------------------------------------------------------
+
+=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);
@@ -657,7 +753,33 @@ sub expandnamed {
return 0;
}
} else {
- return '$c{\''.$expression.'\'}';
+ # it is not a function, so it is a parameter name
+ # We should do the following:
+ # 1. Take the list of parameter names
+ # 2. look through the list for ones that match the parameter we want
+ # 3. If there are no collisions, return the one that matches
+ # 4. If there is a collision, return 'bad parameter name error'
+ my $returnvalue = '';
+ my @matches = ();
+ $#matches = -1;
+ study $expression;
+ foreach $parameter (keys(%c)) {
+ push @matches,$parameter if ($parameter =~ /$expression/);
+ }
+ if ($#matches == 0) {
+ $returnvalue = '$c{\''.$matches[0].'\'}';
+ } elsif ($#matches > 0) {
+ # more than one match. Look for a concise one
+ $returnvalue = "'non-unique parameter name : $expression'";
+ foreach (@matches) {
+ if (/^$expression$/) {
+ $returnvalue = '$c{\''.$_.'\'}';
+ }
+ }
+ } else {
+ $returnvalue = "'bad parameter name : $expression'";
+ }
+ return $returnvalue;
}
}
@@ -669,6 +791,8 @@ sub sett {
} else {
$pattern='[A-Z]';
}
+
+# Deal with the template row
foreach (keys(%f)) {
if ($_=~/template\_(\w)/) {
my $col=$1;
@@ -677,11 +801,17 @@ sub sett {
if ($_=~/A(\d+)/) {
my $trow=$1;
if ($trow) {
+ # Get the name of this cell
my $lb=$col.$trow;
+ # Grab the template declaration
$t{$lb}=$f{'template_'.$col};
+ # Replace '#' with the row number
$t{$lb}=~s/\#/$trow/g;
+ # Replace '....' with ','
$t{$lb}=~s/\.\.+/\,/g;
+ # Replace 'A0' with the value from 'A0'
$t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
+ # Replace parameters
$t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
}
}
@@ -689,8 +819,10 @@ sub sett {
}
}
}
+
+# Deal with the normal cells
foreach (keys(%f)) {
- if (($f{$_}) && ($_!~/template\_/)) {
+ if (exists($f{$_}) && ($_!~/template\_/)) {
my $matches=($_=~/^$pattern(\d+)/);
if (($matches) && ($1)) {
unless ($f{$_}=~/^\!/) {
@@ -704,6 +836,23 @@ sub sett {
}
}
}
+# For inserted lines, [B-Z] is also valid
+
+ unless ($sheettype eq 'assesscalc') {
+ foreach (keys(%f)) {
+ if ($_=~/[B-Z](\d+)/) {
+ if ($f{'A'.$1}=~/^[\~\-]/) {
+ $t{$_}=$f{$_};
+ $t{$_}=~s/\.\.+/\,/g;
+ $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
+ $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
+ }
+ }
+ }
+ }
+
+ # For some reason 'A0' gets special treatment... This seems superfluous
+ # but I imagine it is here for a reason.
$t{'A0'}=$f{'A0'};
$t{'A0'}=~s/\.\.+/\,/g;
$t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
@@ -711,25 +860,26 @@ sub sett {
}
sub calc {
- %v=();
+ undef %v;
&sett();
my $notfinished=1;
+ my $lastcalc='';
my $depth=0;
while ($notfinished) {
$notfinished=0;
foreach (keys(%t)) {
my $old=$v{$_};
- $v{$_}=eval($t{$_});
+ $v{$_}=eval $t{$_};
if ($@) {
- %v=();
- return $@;
+ undef %v;
+ return $_.': '.$@;
}
- if ($v{$_} ne $old) { $notfinished=1; }
+ if ($v{$_} ne $old) { $notfinished=1; $lastcalc=$_; }
}
$depth++;
if ($depth>100) {
- %v=();
- return 'Maximum calculation depth exceeded';
+ undef %v;
+ return $lastcalc.': Maximum calculation depth exceeded';
}
}
return '';
@@ -754,9 +904,11 @@ sub outrowassess {
my @cols=();
if ($n) {
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});
+ if ($rl{$usy}) {
$cols[0]=$rl{$usy}.' '.
'