--- loncom/interface/spreadsheet/Spreadsheet.pm 2003/09/08 20:32:22 1.24
+++ loncom/interface/spreadsheet/Spreadsheet.pm 2003/09/15 20:31:01 1.26
@@ -1,5 +1,5 @@
#
-# $Id: Spreadsheet.pm,v 1.24 2003/09/08 20:32:22 matthew Exp $
+# $Id: Spreadsheet.pm,v 1.26 2003/09/15 20:31:01 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -299,18 +299,23 @@ Returns the safe space required by a Spr
=cut
######################################################
+{
+
+ my $safeeval;
+
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';
+ my $self = shift;
+ 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,'&EXT');
+ $safehole->wrap(\&mask,$safeeval,'&mask');
+ $safeeval->share('$@');
+ my $code=<<'ENDDEFS';
# ---------------------------------------------------- Inside of the safe space
#
# f: formulas
@@ -375,7 +380,7 @@ returns the number of items in the range
#-------------------------------------------------------
sub NUM {
my $mask=&mask(@_);
- my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1;
+ my $num= $#{@{grep(eval("/$mask/"),keys(%sheet_values))}}+1;
return $num;
}
@@ -392,7 +397,7 @@ sub BIN {
my ($low,$high,$lower,$upper)=@_;
my $mask=&mask($lower,$upper);
my $num=0;
- foreach (grep /$mask/,keys(%sheet_values)) {
+ foreach (grep eval("/$mask/"),keys(%sheet_values)) {
if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {
$num++;
}
@@ -414,7 +419,7 @@ returns the sum of items in the range.
sub SUM {
my $mask=&mask(@_);
my $sum=0;
- foreach (grep /$mask/,keys(%sheet_values)) {
+ foreach (grep eval("/$mask/"),keys(%sheet_values)) {
$sum+=$sheet_values{$_};
}
return $sum;
@@ -435,7 +440,7 @@ sub MEAN {
my $mask=&mask(@_);
my $sum=0;
my $num=0;
- foreach (grep /$mask/,keys(%sheet_values)) {
+ foreach (grep eval("/$mask/"),keys(%sheet_values)) {
$sum+=$sheet_values{$_};
$num++;
}
@@ -460,14 +465,14 @@ compute the standard deviation of the it
sub STDDEV {
my $mask=&mask(@_);
my $sum=0; my $num=0;
- foreach (grep /$mask/,keys(%sheet_values)) {
+ foreach (grep eval("/$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)) {
+ foreach (grep eval("/$mask/"),keys(%sheet_values)) {
$sum+=($sheet_values{$_}-$mean)**2;
}
return sqrt($sum/($num-1));
@@ -487,7 +492,7 @@ compute the product of the items in the
sub PROD {
my $mask=&mask(@_);
my $prod=1;
- foreach (grep /$mask/,keys(%sheet_values)) {
+ foreach (grep eval("/$mask/"),keys(%sheet_values)) {
$prod*=$sheet_values{$_};
}
return $prod;
@@ -507,7 +512,7 @@ compute the maximum of the items in the
sub MAX {
my $mask=&mask(@_);
my $max='-';
- foreach (grep /$mask/,keys(%sheet_values)) {
+ foreach (grep eval("/$mask/"),keys(%sheet_values)) {
unless ($max) { $max=$sheet_values{$_}; }
if (($sheet_values{$_}>$max) || ($max eq '-')) {
$max=$sheet_values{$_};
@@ -530,7 +535,7 @@ compute the minimum of the items in the
sub MIN {
my $mask=&mask(@_);
my $min='-';
- foreach (grep /$mask/,keys(%sheet_values)) {
+ foreach (grep eval("/$mask/"),keys(%sheet_values)) {
unless ($max) { $max=$sheet_values{$_}; }
if (($sheet_values{$_}<$min) || ($min eq '-')) {
$min=$sheet_values{$_};
@@ -555,7 +560,7 @@ sub SUMMAX {
my ($num,$lower,$upper)=@_;
my $mask=&mask($lower,$upper);
my @inside=();
- foreach (grep /$mask/,keys(%sheet_values)) {
+ foreach (grep eval("/$mask/"),keys(%sheet_values)) {
push (@inside,$sheet_values{$_});
}
@inside=sort(@inside);
@@ -582,7 +587,7 @@ sub SUMMIN {
my ($num,$lower,$upper)=@_;
my $mask=&mask($lower,$upper);
my @inside=();
- foreach (grep /$mask/,keys(%sheet_values)) {
+ foreach (grep eval("/$mask/"),keys(%sheet_values)) {
$inside[$#inside+1]=$sheet_values{$_};
}
@inside=sort(@inside);
@@ -677,7 +682,8 @@ sub calc {
# ------------------------------------------- End of "Inside of the safe space"
ENDDEFS
- $safeeval->reval($code);
+ $safeeval->reval($code);
+ }
$self->{'safe'} = $safeeval;
$self->{'root'} = $self->{'safe'}->root();
#
@@ -691,6 +697,9 @@ ENDDEFS
$self->{'safe'}->reval($initstring);
return $self;
}
+
+}
+
######################################################
=pod
@@ -704,6 +713,17 @@ 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
######################################################
{
@@ -718,78 +738,57 @@ sub mask {
}
$upper = $lower if (! defined($upper));
#
- my ($la,$ld) = ($lower=~/([A-Za-z]|\*)(\d+|\*)/);
- my ($ua,$ud) = ($upper=~/([A-Za-z]|\*)(\d+|\*)/);
+ 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-Za-z]';
+ $alpha='[A-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+';
+ $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 {
- 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].']';
- }
- }
- }
+ $num = '(\d+)';
}
- my $expression ='^'.$alpha.$num."\$";
+ 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;
+}
+
}
##