[LON-CAPA-cvs] cvs: loncom /interface/spreadsheet Spreadsheet.pm
matthew
lon-capa-cvs@mail.lon-capa.org
Mon, 15 Sep 2003 20:31:02 -0000
matthew Mon Sep 15 16:31:02 2003 EDT
Modified files:
/loncom/interface/spreadsheet Spreadsheet.pm
Log:
Complete rewrite of &mask to return more correct regular expressions.
This is to fix a bug where &mask("X15","X24") would return ^[X-X][5-4]$.
Now it returns ^[X-X](\d+)(?(?{$1>= 15 && $1<=24})|donotmatch)$, which is
actually clearer although it does not appear so at first glance. A comment
was added to &mask to explain the regular expression.
POD documented &mask, added a debugging helper, and modified all of the
calls to &mask to wrap its result in an eval as such complexities require
using an eval. I would reference a bug here but bugzilla is down.
Index: loncom/interface/spreadsheet/Spreadsheet.pm
diff -u loncom/interface/spreadsheet/Spreadsheet.pm:1.25 loncom/interface/spreadsheet/Spreadsheet.pm:1.26
--- loncom/interface/spreadsheet/Spreadsheet.pm:1.25 Fri Sep 12 14:59:48 2003
+++ loncom/interface/spreadsheet/Spreadsheet.pm Mon Sep 15 16:31:01 2003
@@ -1,5 +1,5 @@
#
-# $Id: Spreadsheet.pm,v 1.25 2003/09/12 18:59:48 matthew Exp $
+# $Id: Spreadsheet.pm,v 1.26 2003/09/15 20:31:01 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -380,7 +380,7 @@
#-------------------------------------------------------
sub NUM {
my $mask=&mask(@_);
- my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1;
+ my $num= $#{@{grep(eval("/$mask/"),keys(%sheet_values))}}+1;
return $num;
}
@@ -397,7 +397,7 @@
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++;
}
@@ -419,7 +419,7 @@
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;
@@ -440,7 +440,7 @@
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++;
}
@@ -465,14 +465,14 @@
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));
@@ -492,7 +492,7 @@
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;
@@ -512,7 +512,7 @@
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{$_};
@@ -535,7 +535,7 @@
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{$_};
@@ -560,7 +560,7 @@
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);
@@ -587,7 +587,7 @@
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);
@@ -713,6 +713,17 @@
######################################################
+=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
######################################################
{
@@ -727,76 +738,55 @@
}
$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;
}
}