--- loncom/interface/Attic/lonspreadsheet.pm 2002/04/08 18:28:03 1.81 +++ loncom/interface/Attic/lonspreadsheet.pm 2002/09/01 18:06:52 1.106 @@ -1,5 +1,5 @@ # -# $Id: lonspreadsheet.pm,v 1.81 2002/04/08 18:28:03 matthew Exp $ +# $Id: lonspreadsheet.pm,v 1.106 2002/09/01 18:06:52 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 @@ -133,37 +142,39 @@ sub initsheet { # rl: row label # os: other spreadsheets (for student spreadsheet only) -undef %v; +undef %sheet_values; undef %t; undef %f; undef %c; -undef %rl; +undef %rowlabel; undef @os; -$maxrow=0; -$sheettype=''; +$maxrow = 0; +$sheettype = ''; # filename/reference of the sheet - -$filename=''; +$filename = ''; # user data -$uname=''; -$uhome=''; -$udom=''; +$uname = ''; +$uhome = ''; +$udom = ''; # course data -$csec=''; -$chome=''; -$cnum=''; -$cdom=''; -$cid=''; -$cfn=''; +$csec = ''; +$chome= ''; +$cnum = ''; +$cdom = ''; +$cid = ''; +$cfn = ''; # symb -$usymb=''; +$usymb = ''; + +# error messages +$errormsg = ''; sub mask { my ($lower,$upper)=@_; @@ -372,8 +383,8 @@ sub CDLHASH { if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { my $keymask = &mask($key); # Assume the keys are addresses - my @Temp = grep /$keymask/,keys(%v); - @Keys = $v{@Temp}; + my @Temp = grep /$keymask/,keys(%sheet_values); + @Keys = $sheet_values{@Temp}; } else { $Keys[0]= $key; } @@ -384,8 +395,8 @@ sub CDLHASH { @Keys = @Temp; if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { my $valmask = &mask($value); - my @Temp = grep /$valmask/,keys(%v); - @Values =$v{@Temp}; + my @Temp = grep /$valmask/,keys(%sheet_values); + @Values =$sheet_values{@Temp}; } else { $Values[0]= $value; } @@ -419,7 +430,7 @@ sub GETHASH { $index = 0; } if ($key =~ /^[A-z]\d+$/) { - $key = $v{$key}; + $key = $sheet_values{$key}; } return $hashes{$name}->{$key}->[$index]; } @@ -476,8 +487,8 @@ sub HASH { if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { my $keymask = &mask($key); # Assume the keys are addresses - my @Temp = grep /$keymask/,keys(%v); - @Keys = $v{@Temp}; + my @Temp = grep /$keymask/,keys(%sheet_values); + @Keys = $sheet_values{@Temp}; } else { $Keys[0]= $key; } @@ -489,8 +500,8 @@ sub HASH { # Check to see if we have multiple $value(s) if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { my $valmask = &mask($value); - my @Temp = grep /$valmask/,keys(%v); - @Values =$v{@Temp}; + my @Temp = grep /$valmask/,keys(%sheet_values); + @Values =$sheet_values{@Temp}; } else { $Values[0]= $value; } @@ -508,9 +519,18 @@ 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; + my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1; return $num; } @@ -518,8 +538,8 @@ sub BIN { my ($low,$high,$lower,$upper)=@_; my $mask=mask($lower,$upper); my $num=0; - foreach (grep /$mask/,keys(%v)) { - if (($v{$_}>=$low) && ($v{$_}<=$high)) { + foreach (grep /$mask/,keys(%sheet_values)) { + if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) { $num++; } } @@ -527,20 +547,38 @@ sub BIN { } +#------------------------------------------------------- + +=item SUM(range) + +returns the sum of items in the range. + +=cut + +#------------------------------------------------------- sub SUM { my $mask=mask(@_); my $sum=0; - foreach (grep /$mask/,keys(%v)) { - $sum+=$v{$_}; + foreach (grep /$mask/,keys(%sheet_values)) { + $sum+=$sheet_values{$_}; } 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; - foreach (grep /$mask/,keys(%v)) { - $sum+=$v{$_}; + foreach (grep /$mask/,keys(%sheet_values)) { + $sum+=$sheet_values{$_}; $num++; } if ($num) { @@ -550,57 +588,105 @@ 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; - foreach (grep /$mask/,keys(%v)) { - $sum+=$v{$_}; + foreach (grep /$mask/,keys(%sheet_values)) { + $sum+=$sheet_values{$_}; $num++; } unless ($num>1) { return undef; } my $mean=$sum/$num; $sum=0; - foreach (grep /$mask/,keys(%v)) { - $sum+=($v{$_}-$mean)**2; + foreach (grep /$mask/,keys(%sheet_values)) { + $sum+=($sheet_values{$_}-$mean)**2; } 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; - foreach (grep /$mask/,keys(%v)) { - $prod*=$v{$_}; + foreach (grep /$mask/,keys(%sheet_values)) { + $prod*=$sheet_values{$_}; } return $prod; } +#------------------------------------------------------- + +=item MAX(range) + +compute the maximum of the items in the range. + +=cut + +#------------------------------------------------------- sub MAX { my $mask=mask(@_); my $max='-'; - foreach (grep /$mask/,keys(%v)) { - unless ($max) { $max=$v{$_}; } - if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; } + foreach (grep /$mask/,keys(%sheet_values)) { + unless ($max) { $max=$sheet_values{$_}; } + if (($sheet_values{$_}>$max) || ($max eq '-')) { $max=$sheet_values{$_}; } } return $max; } +#------------------------------------------------------- + +=item MIN(range) + +compute the minimum of the items in the range. + +=cut + +#------------------------------------------------------- sub MIN { my $mask=mask(@_); my $min='-'; - foreach (grep /$mask/,keys(%v)) { - unless ($max) { $max=$v{$_}; } - if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; } + foreach (grep /$mask/,keys(%sheet_values)) { + unless ($max) { $max=$sheet_values{$_}; } + if (($sheet_values{$_}<$min) || ($min eq '-')) { + $min=$sheet_values{$_}; + } } 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{$_}; + foreach (grep /$mask/,keys(%sheet_values)) { + push (@inside,$sheet_values{$_}); } @inside=sort(@inside); my $sum=0; my $i; @@ -610,12 +696,22 @@ 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); my @inside=(); - foreach (grep /$mask/,keys(%v)) { - $inside[$#inside+1]=$v{$_}; + foreach (grep /$mask/,keys(%sheet_values)) { + $inside[$#inside+1]=$sheet_values{$_}; } @inside=sort(@inside); my $sum=0; my $i; @@ -625,6 +721,53 @@ sub SUMMIN { return $sum; } +#------------------------------------------------------- + +=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; + study($expression); + foreach $parameter (keys(%c)) { + next if ($parameter !~ /$expression/); + if ((! defined($min)) || ($min > $c{$parameter})) { + $min = $c{$parameter} + } + } + return $min; +} + +#------------------------------------------------------- + +=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; + study($expression); + foreach $parameter (keys(%c)) { + next if ($parameter !~ /$expression/); + if ((! defined($min)) || ($max < $c{$parameter})) { + $max = $c{$parameter} + } + } + return $max; +} + +#-------------------------------------------------------- sub expandnamed { my $expression=shift; if ($expression=~/^\&/) { @@ -657,7 +800,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,26 +838,30 @@ sub sett { } else { $pattern='[A-Z]'; } + # Deal with the template row foreach (keys(%f)) { - if ($_=~/template\_(\w)/) { - my $col=$1; - unless ($col=~/^$pattern/) { - foreach (keys(%f)) { - if ($_=~/A(\d+)/) { - my $trow=$1; - if ($trow) { - my $lb=$col.$trow; - $t{$lb}=$f{'template_'.$col}; - $t{$lb}=~s/\#/$trow/g; - $t{$lb}=~s/\.\.+/\,/g; - $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g; - $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; - } - } - } - } - } + next if ($_!~/template\_(\w)/); + my $col=$1; + next if ($col=~/^$pattern/); + foreach (keys(%f)) { + next if ($_!~/A(\d+)/); + my $trow=$1; + next 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\$sheet_values\{\'$2\'\}/g; + # Replace parameters + $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; + } } + # Deal with the normal cells foreach (keys(%f)) { if (($f{$_}) && ($_!~/template\_/)) { my $matches=($_=~/^$pattern(\d+)/); @@ -699,37 +872,53 @@ sub sett { } else { $t{$_}=$f{$_}; $t{$_}=~s/\.\.+/\,/g; - $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g; + $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; } } } + # 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\$sheet_values\{\'$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; + $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; } sub calc { - %v=(); + undef %sheet_values; &sett(); my $notfinished=1; + my $lastcalc=''; my $depth=0; while ($notfinished) { $notfinished=0; foreach (keys(%t)) { - my $old=$v{$_}; - $v{$_}=eval($t{$_}); + my $old=$sheet_values{$_}; + $sheet_values{$_}=eval $t{$_}; if ($@) { - %v=(); - return $@; + undef %sheet_values; + return $_.': '.$@; } - if ($v{$_} ne $old) { $notfinished=1; } + if ($sheet_values{$_} ne $old) { $notfinished=1; $lastcalc=$_; } } $depth++; if ($depth>100) { - %v=(); - return 'Maximum calculation depth exceeded'; + undef %sheet_values; + return $lastcalc.': Maximum calculation depth exceeded'; } } return ''; @@ -744,29 +933,38 @@ sub templaterow { 'n','o','p','q','r','s','t','u','v','w','x','y','z') { my $fm=$f{'template_'.$_}; $fm=~s/[\'\"]/\&\#34;/g; - $cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm; + push(@cols,"'template_$_','$fm'".'___eq___'.$fm); } return @cols; } +# +# This is actually used for the student spreadsheet, not the assessment sheet +# Do not be fooled by the name! +# sub outrowassess { + # $n is the current row number my $n=shift; my @cols=(); if ($n) { - my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n}); - $cols[0]=$rl{$usy}.'
'. - ''. + ''; + } else { + $cols[0]=''; + } + foreach (@os) { + $cols[0].='