--- loncom/interface/Attic/lonspreadsheet.pm 2002/04/11 13:35:23 1.84 +++ loncom/interface/Attic/lonspreadsheet.pm 2002/10/18 13:46:01 1.118 @@ -1,5 +1,5 @@ # -# $Id: lonspreadsheet.pm,v 1.84 2002/04/11 13:35:23 matthew Exp $ +# $Id: lonspreadsheet.pm,v 1.118 2002/10/18 13:46:01 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,16 +26,6 @@ # The LearningOnline Network with CAPA # Spreadsheet/Grades Display Handler # -# 11/11,11/15,11/27,12/04,12/05,12/06,12/07, -# 12/08,12/09,12/11,12/12,12/15,12/16,12/18,12/19,12/30, -# 01/01/01,02/01,03/01,19/01,20/01,22/01, -# 03/05,03/08,03/10,03/12,03/13,03/15,03/17, -# 03/19,03/20,03/21,03/27,04/05,04/09, -# 07/09,07/14,07/21,09/01,09/10,9/11,9/12,9/13,9/14,9/17, -# 10/16,10/17,10/20,11/05,11/28,12/27 Gerd Kortemeyer -# 01/14/02 Matthew -# 02/04/02 Matthew - # POD required stuff: =head1 NAME @@ -54,7 +44,6 @@ not the grades of their peers. The spre offering the ability to use Perl code to manipulate data, as well as many built-in functions. - =head2 Functions available to user of lonspreadsheet =over 4 @@ -71,6 +60,12 @@ use Apache::lonnet; use Apache::Constants qw(:common :http); use GDBM_File; use HTML::TokeParser; +use Apache::lonhtmlcommon; +use Apache::loncoursedata; +# +# Caches for coursewide information +# +my %Section; # # Caches for previously calculated spreadsheets @@ -106,6 +101,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; @@ -114,57 +117,9 @@ my $tmpdir; # ============================================================================= # ===================================== Implements an instance of a spreadsheet -sub initsheet { - 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'); - my $code=<<'ENDDEFS'; -# ---------------------------------------------------- Inside of the safe space - -# -# f: formulas -# t: intermediate format (variable references expanded) -# v: output values -# c: preloaded constants (A-column) -# rl: row label -# os: other spreadsheets (for student spreadsheet only) - -undef %v; -undef %t; -undef %f; -undef %c; -undef %rl; -undef @os; - -$maxrow=0; -$sheettype=''; - -# filename/reference of the sheet - -$filename=''; - -# user data -$uname=''; -$uhome=''; -$udom=''; - -# course data - -$csec=''; -$chome=''; -$cnum=''; -$cdom=''; -$cid=''; -$cfn=''; - -# symb - -$usymb=''; - +## +## mask - used to reside in the safe space. +## sub mask { my ($lower,$upper)=@_; @@ -188,7 +143,6 @@ sub mask { $alpha='['.$la.'-Za-'.$ua.']'; } } - if (($ld eq '*') || ($ud eq '*')) { $num='\d+'; } else { @@ -208,7 +162,9 @@ sub mask { } else { my @lda=($ld=~m/\d/g); my @uda=($ud=~m/\d/g); - my $i; $j=0; $notdone=1; + my $i; + my $j=0; + my $notdone=1; for ($i=0;($i<=$#lda)&&($notdone);$i++) { if ($lda[$i]==$uda[$i]) { $num.=$lda[$i]; @@ -241,6 +197,65 @@ sub mask { return '^'.$alpha.$num."\$"; } + + +sub initsheet { + 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(\&Apache::lonspreadsheet::mask,$safeeval,'&mask'); + $safehole->wrap(\&Apache::lonspreadsheet::templaterow,$safeeval,'&templaterow'); + $safeeval->share('$@'); + my $code=<<'ENDDEFS'; +# ---------------------------------------------------- Inside of the safe space + +# +# f: formulas +# t: intermediate format (variable references expanded) +# v: output values +# c: preloaded constants (A-column) +# rl: row label +# os: other spreadsheets (for student spreadsheet only) + +undef %sheet_values; +undef %t; +undef %f; +undef %c; +undef %rowlabel; +undef @os; + +$maxrow = 0; +$sheettype = ''; + +# filename/reference of the sheet +$filename = ''; + +# user data +$uname = ''; +$uhome = ''; +$udom = ''; + +# course data + +$csec = ''; +$chome= ''; +$cnum = ''; +$cdom = ''; +$cid = ''; +$coursefilename = ''; + +# symb + +$usymb = ''; + +# error messages +$errormsg = ''; + + #------------------------------------------------------- =item UWCALC(hashname,modules,units,date) @@ -372,8 +387,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 +399,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 +434,7 @@ sub GETHASH { $index = 0; } if ($key =~ /^[A-z]\d+$/) { - $key = $v{$key}; + $key = $sheet_values{$key}; } return $hashes{$name}->{$key}->[$index]; } @@ -476,8 +491,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 +504,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; } @@ -519,7 +534,7 @@ returns the number of items in the range #------------------------------------------------------- sub NUM { my $mask=mask(@_); - my $num= $#{@{grep(/$mask/,keys(%v))}}+1; + my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1; return $num; } @@ -527,8 +542,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++; } } @@ -548,8 +563,8 @@ returns the sum of items in the range. 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; } @@ -566,8 +581,8 @@ compute the average of the items in the 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) { @@ -589,15 +604,15 @@ compute the standard deviation of the it 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)); } @@ -614,8 +629,8 @@ compute the product of the items in the 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; } @@ -632,9 +647,9 @@ compute the maximum of the items in the 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; } @@ -651,9 +666,11 @@ compute the minimum of the items in the 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; } @@ -672,8 +689,8 @@ sub SUMMAX { my ($num,$lower,$upper)=@_; my $mask=mask($lower,$upper); my @inside=(); - foreach (grep /$mask/,keys(%v)) { - push (@inside,$v{$_}); + foreach (grep /$mask/,keys(%sheet_values)) { + push (@inside,$sheet_values{$_}); } @inside=sort(@inside); my $sum=0; my $i; @@ -697,8 +714,8 @@ 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; @@ -708,6 +725,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=~/^\&/) { @@ -740,7 +804,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; } } @@ -752,28 +842,32 @@ 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\_/)) { + if (exists($f{$_}) && ($_!~/template\_/)) { my $matches=($_=~/^$pattern(\d+)/); if (($matches) && ($1)) { unless ($f{$_}=~/^\!/) { @@ -782,74 +876,85 @@ 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 ''; } -sub templaterow { - my @cols=(); - $cols[0]='Template'; - foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', - 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', - 'a','b','c','d','e','f','g','h','i','j','k','l','m', - '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; - } - 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].='