--- loncom/interface/Attic/lonspreadsheet.pm 2002/07/04 17:51:32 1.93 +++ loncom/interface/Attic/lonspreadsheet.pm 2002/10/29 16:04:13 1.130 @@ -1,5 +1,5 @@ # -# $Id: lonspreadsheet.pm,v 1.93 2002/07/04 17:51:32 www Exp $ +# $Id: lonspreadsheet.pm,v 1.130 2002/10/29 16:04:13 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,73 +117,22 @@ 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)=@_; - - $lower=~/([A-Za-z]|\*)(\d+|\*)/; - my $la=$1; - my $ld=$2; - - $upper=~/([A-Za-z]|\*)(\d+|\*)/; - my $ua=$1; - my $ud=$2; + # + my ($la,$ld) = ($lower=~/([A-Za-z]|\*)(\d+|\*)/); + my ($ua,$ud) = ($upper=~/([A-Za-z]|\*)(\d+|\*)/); + # my $alpha=''; my $num=''; - + # if (($la eq '*') || ($ua eq '*')) { $alpha='[A-Za-z]'; } else { + if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) || ($la=~/[a-z]/) && ($ua=~/[a-z]/)) { $alpha='['.$la.'-'.$ua.']'; @@ -188,7 +140,6 @@ sub mask { $alpha='['.$la.'-Za-'.$ua.']'; } } - if (($ld eq '*') || ($ud eq '*')) { $num='\d+'; } else { @@ -208,7 +159,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]; @@ -232,8 +185,8 @@ sub mask { } $num.=')'; } else { - if ($lda[$#lda]!=$uda[$#uda]) { - $num.='['.$lda[$#lda].'-'.$uda[$#uda].']'; + if ($lda[-1]!=$uda[-1]) { + $num.='['.$lda[-1].'-'.$uda[-1].']'; } } } @@ -241,6 +194,79 @@ 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'); + $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; # Holds the (computed, final) values for the sheet + # This is only written to by &calc, the spreadsheet computation routine. + # It is read by many functions +undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett, + # which does the translation of strings like C5 into the value in C5. + # Used in &calc - %t holds the values that are actually eval'd. +undef %f; # Holds the formulas for each cell. This is the users + # (spreadsheet authors) data for each cell. + # set by &setformulas and returned by &getformulas + # &setformulas is called by &readsheet, &tmpread, &updateclasssheet, + # &updatestudentassesssheet, &loadstudent, &loadcourse + # &getformulas is called by &writesheet, &tmpwrite, &updateclasssheet, + # &updatestudentassesssheet, &loadstudent, &loadcourse, &loadassessment, +undef %c; # Holds the constants for a sheet. In the assessment + # sheets, this is the A column. Used in &MINPARM, &MAXPARM, &expandnamed, + # &sett, and &setconstants. There is no &getconstants. + # &setconstants is called by &loadstudent, &loadcourse, &load assessment, +undef @os; # Holds the names of other spreadsheets - this is used to specify + # the spreadsheets that are available for the assessment sheet. + # Set by &setothersheets. &setothersheets is called by &handler. A + # related subroutine is &othersheets. + +$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 +398,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 +410,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 +445,7 @@ sub GETHASH { $index = 0; } if ($key =~ /^[A-z]\d+$/) { - $key = $v{$key}; + $key = $sheet_values{$key}; } return $hashes{$name}->{$key}->[$index]; } @@ -476,8 +502,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 +515,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 +545,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 +553,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 +574,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 +592,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 +615,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 +640,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 +658,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 +677,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 +700,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 +725,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 +736,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=~/^\&/) { @@ -753,10 +828,22 @@ sub expandnamed { foreach $parameter (keys(%c)) { push @matches,$parameter if ($parameter =~ /$expression/); } - if ($#matches == 0) { + if (scalar(@matches) == 0) { + $returnvalue = 'unmatched parameter: '.$parameter; + } elsif (scalar(@matches) == 1) { $returnvalue = '$c{\''.$matches[0].'\'}'; + } elsif (scalar(@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'"; + # There was a negative number of matches, which indicates + # something is wrong with reality. Better warn the user. + $returnvalue = 'bizzare parameter: '.$parameter; } return $returnvalue; } @@ -770,34 +857,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) { - # 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; - } - } - } - } - } + 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{$_}=~/^\!/) { @@ -806,95 +891,131 @@ 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 ''; } +# ------------------------------------------- End of "Inside of the safe space" +ENDDEFS + $safeeval->reval($code); + return $safeeval; +} + +# +# +# sub templaterow { + my $sheet = shift; 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_'.$_}; + my $fm=$sheet->{'f'}->{'template_'.$_}; $fm=~s/[\'\"]/\&\#34;/g; - $cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm; + push(@cols,"'template_$_','$fm'".'___eq___'.$fm); } return @cols; } + sub outrowassess { - my $n=shift; + # $n is the current row number + my $sheet = shift; + my $n=shift; + my $csv = $ENV{'form.showcsv'}; my @cols=(); if ($n) { - my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n}); - if ($rl{$usy}) { - $cols[0]=$rl{$usy}.'
'. - ''. + ''; } - $cols[0].='>'.$_.''; - } - $cols[0].=''; + } else { + $cols[0]=''; + } + if (! $csv) { + foreach (@{$sheet->{'othersheets'}}) { + $cols[0].='