--- loncom/interface/Attic/lonspreadsheet.pm 2002/04/10 15:30:13 1.83
+++ loncom/interface/Attic/lonspreadsheet.pm 2002/08/30 19:47:47 1.104
@@ -1,5 +1,5 @@
#
-# $Id: lonspreadsheet.pm,v 1.83 2002/04/10 15:30:13 matthew Exp $
+# $Id: lonspreadsheet.pm,v 1.104 2002/08/30 19:47:47 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]='Export';
+ $cols[0]='Export';
}
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',
@@ -774,7 +972,7 @@ sub outrowassess {
'n','o','p','q','r','s','t','u','v','w','x','y','z') {
my $fm=$f{$_.$n};
$fm=~s/[\'\"]/\&\#34;/g;
- push(@cols,"'$_$n','$fm'".'___eq___'.$v{$_.$n});
+ push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n});
}
return @cols;
}
@@ -783,7 +981,7 @@ sub outrow {
my $n=shift;
my @cols=();
if ($n) {
- $cols[0]=$rl{$f{'A'.$n}};
+ $cols[0]=$rowlabel{$f{'A'.$n}};
} else {
$cols[0]='Export';
}
@@ -793,7 +991,7 @@ sub outrow {
'n','o','p','q','r','s','t','u','v','w','x','y','z') {
my $fm=$f{$_.$n};
$fm=~s/[\'\"]/\&\#34;/g;
- $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
+ push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n});
}
return @cols;
}
@@ -802,7 +1000,7 @@ sub exportrowa {
my @exportarray=();
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') {
- $exportarray[$#exportarray+1]=$v{$_.'0'};
+ push(@exportarray,$sheet_values{$_.'0'});
}
return @exportarray;
}
@@ -837,22 +1035,22 @@ sub setothersheets {
# ------------------------------------------------ Add or change formula values
sub setrowlabels {
- my ($safeeval,%rl)=@_;
- %{$safeeval->varglob('rl')}=%rl;
+ my ($safeeval,%rowlabel)=@_;
+ %{$safeeval->varglob('rowlabel')}=%rowlabel;
}
# ------------------------------------------------------- Calculate spreadsheet
sub calcsheet {
my $safeeval=shift;
- $safeeval->reval('&calc();');
+ return $safeeval->reval('&calc();');
}
# ------------------------------------------------------------------ Get values
sub getvalues {
my $safeeval=shift;
- return $safeeval->reval('%v');
+ return $safeeval->reval('%sheet_values');
}
# ---------------------------------------------------------------- Get formulas
@@ -862,6 +1060,13 @@ sub getformulas {
return %{$safeeval->varglob('f')};
}
+# ----------------------------------------------------- Get value of $f{'A'.$n}
+
+sub getfa {
+ my ($safeeval,$n)=@_;
+ return $safeeval->reval('$f{"A'.$n.'"}');
+}
+
# -------------------------------------------------------------------- Get type
sub gettype {
@@ -1000,7 +1205,7 @@ sub rown {
}
my $showf=0;
my $proc;
- my $maxred;
+ my $maxred=1;
my $sheettype=&gettype($safeeval);
if ($sheettype eq 'studentcalc') {
$proc='&outrowassess';
@@ -1013,7 +1218,12 @@ sub rown {
} else {
$maxred=26;
}
- if ($n eq '-') { $proc='&templaterow'; $n=-1; $dataflag=1; }
+ if (&getfa($safeeval,$n)=~/^[\~\-]/) { $maxred=1; }
+ if ($n eq '-') {
+ $proc='&templaterow';
+ $n=-1;
+ $dataflag=1;
+ }
foreach ($safeeval->reval($proc.'('.$n.')')) {
my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
@@ -1071,20 +1281,20 @@ sub outsheet {
'>Import'.
'
'; } $r->print($tabledata); @@ -1099,7 +1309,6 @@ sub outsheet { $sortidx[$row-1]=$row-1; } @sortidx=sort { $sortby[$a] cmp $sortby[$b]; } @sortidx; - my $what='Student'; if (&gettype($safeeval) eq 'assesscalc') { $what='Item'; @@ -1109,23 +1318,20 @@ sub outsheet { my $n=0; for ($row=0;$row<$maxrow;$row++) { - my $thisrow=&rown($safeeval,$sortidx[$row]+1); - if ($thisrow) { - if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) { - $r->print("\n
\n"); - $r->rflush(); - $r->print('
'.$what.' | '); - 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') { - $r->print(''.$_.' | '); + my $thisrow=&rown($safeeval,$sortidx[$row]+1); + if ($thisrow) { + if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) { + $r->print("
'.$what.' | '); + $r->print(''.join(' | ', + (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. + 'abcdefghijklmnopqrstuvwxyz'))). + " |
$sheetxml"; - if ($sheetxml == -1) { - $sheetxml='
"; - foreach (sort( keys(%f))) { - print "$_ = $f{$_}\n"; - } - print ""; - } else { - my $sheet=''; - my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum); - my ($tmp) = keys(%tmphash); - unless ($tmp =~ /^(con_lost|error|no_such_host)/i) { - foreach (keys(%tmphash)) { - $f{$_}=$tmphash{$_}; - } - } - } -# --------------------------------------------------------------- Cache and set - $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); - &setformulas($safeeval,%f); + my ($safeeval,$fn)=@_; + my $stype = &gettype($safeeval); + my $cnum = &getcnum($safeeval); + my $cdom = &getcdom($safeeval); + my $chome = &getchome($safeeval); + + if (! defined($fn)) { + # There is no filename. Look for defaults in course and global, cache + unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) { + my %tmphash = &Apache::lonnet::get('environment', + ['spreadsheet_default_'.$stype], + $cdom,$cnum); + my ($tmp) = keys(%tmphash); + if ($tmp =~ /^(con_lost|error|no_such_host)/i) { + $fn = 'default_'.$stype; + } else { + $fn = $tmphash{'spreadsheet_default_'.$stype}; + } + unless (($fn) && ($fn!~/^error\:/)) { + $fn='default_'.$stype; + } + $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; + } + } + # $fn now has a value + &setfilename($safeeval,$fn); + # see if sheet is cached + my $fstring=''; + if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) { + &setformulas($safeeval,split(/\_\_\_\;\_\_\_/,$fstring)); + } else { + # Not cached, need to read + my %f=(); + if ($fn=~/^default\_/) { + my $sheetxml=''; + my $fh; + my $dfn=$fn; + $dfn=~s/\_/\./g; + if ($fh=Apache::File->new($includedir.'/'.$dfn)) { + $sheetxml=join('',<$fh>); + } else { + $sheetxml='
$title:
".
- '';
+ '';
}
sub hiddenfield {
@@ -2044,6 +2202,7 @@ sub checkthis {
my ($keyname,$time)=@_;
return ($time<$expiredates{$keyname});
}
+
sub forcedrecalc {
my ($uname,$udom,$stype,$usymb)=@_;
my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
@@ -2075,131 +2234,122 @@ sub forcedrecalc {
#
sub exportsheet {
- my ($uname,$udom,$stype,$usymb,$fn)=@_;
- my @exportarr=();
-
- if (($usymb=~/^\_(\w+)/) && (!$fn)) {
- $fn='default_'.$1;
- }
-
-#
-# Check if cached
-#
-
- my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
- my $found='';
-
- if ($oldsheets{$key}) {
- foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
- my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
- if ($name eq $fn) {
- $found=$value;
- }
- }
- }
-
- unless ($found) {
- &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));
- if ($oldsheets{$key}) {
- foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
+ my ($uname,$udom,$stype,$usymb,$fn)=@_;
+ my @exportarr=();
+ if (($usymb=~/^\_(\w+)/) && (!$fn)) {
+ $fn='default_'.$1;
+ }
+ #
+ # Check if cached
+ #
+ my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
+ my $found='';
+ if ($oldsheets{$key}) {
+ foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
if ($name eq $fn) {
- $found=$value;
+ $found=$value;
}
- }
- }
- }
-#
-# Check if still valid
-#
- if ($found) {
- if (&forcedrecalc($uname,$udom,$stype,$usymb)) {
- $found='';
- }
- }
-
- if ($found) {
-#
-# Return what was cached
-#
- @exportarr=split(/\_\_\_\;\_\_\_/,$found);
-
- } else {
-#
-# Not cached
-#
-
- my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb);
- &readsheet($thissheet,$fn);
- &updatesheet($thissheet);
- &loadrows($thissheet);
- &calcsheet($thissheet);
- @exportarr=&exportdata($thissheet);
-#
-# Store now
-#
- my $cid=$ENV{'request.course.id'};
- my $current='';
- if ($stype eq 'studentcalc') {
- $current=&Apache::lonnet::reply('get:'.
- $ENV{'course.'.$cid.'.domain'}.':'.
- $ENV{'course.'.$cid.'.num'}.
- ':nohist_calculatedsheets:'.
- &Apache::lonnet::escape($key),
- $ENV{'course.'.$cid.'.home'});
- } else {
- $current=&Apache::lonnet::reply('get:'.
- &getudom($thissheet).':'.
- &getuname($thissheet).
- ':nohist_calculatedsheets_'.
- $ENV{'request.course.id'}.':'.
- &Apache::lonnet::escape($key),
- &getuhome($thissheet));
-
+ }
}
- my %currentlystored=();
- unless ($current=~/^error\:/) {
- foreach (split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current))) {
- my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
- $currentlystored{$name}=$value;
- }
+ unless ($found) {
+ &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));
+ if ($oldsheets{$key}) {
+ foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
+ my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
+ if ($name eq $fn) {
+ $found=$value;
+ }
+ }
+ }
}
- $currentlystored{$fn}=join('___;___',@exportarr);
-
- my $newstore='';
- foreach (keys(%currentlystored)) {
- if ($newstore) { $newstore.='___&___'; }
- $newstore.=$_.'___=___'.$currentlystored{$_};
+ #
+ # Check if still valid
+ #
+ if ($found) {
+ if (&forcedrecalc($uname,$udom,$stype,$usymb)) {
+ $found='';
+ }
+ }
+ if ($found) {
+ #
+ # Return what was cached
+ #
+ @exportarr=split(/\_\_\_\;\_\_\_/,$found);
+ } else {
+ #
+ # Not cached
+ #
+ my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb);
+ &readsheet($thissheet,$fn);
+ &updatesheet($thissheet);
+ &loadrows($thissheet);
+ &calcsheet($thissheet);
+ @exportarr=&exportdata($thissheet);
+ #
+ # Store now
+ #
+ my $cid=$ENV{'request.course.id'};
+ my $current='';
+ if ($stype eq 'studentcalc') {
+ $current=&Apache::lonnet::reply('get:'.
+ $ENV{'course.'.$cid.'.domain'}.':'.
+ $ENV{'course.'.$cid.'.num'}.
+ ':nohist_calculatedsheets:'.
+ &Apache::lonnet::escape($key),
+ $ENV{'course.'.$cid.'.home'});
+ } else {
+ $current=&Apache::lonnet::reply('get:'.
+ &getudom($thissheet).':'.
+ &getuname($thissheet).
+ ':nohist_calculatedsheets_'.
+ $ENV{'request.course.id'}.':'.
+ &Apache::lonnet::escape($key),
+ &getuhome($thissheet));
+ }
+ my %currentlystored=();
+ unless ($current=~/^error\:/) {
+ foreach (split(/___&\___/,&Apache::lonnet::unescape($current))) {
+ my ($name,$value)=split(/___=___/,$_);
+ $currentlystored{$name}=$value;
+ }
+ }
+ $currentlystored{$fn}=join('___;___',@exportarr);
+ #
+ my $newstore='';
+ foreach (keys(%currentlystored)) {
+ if ($newstore) { $newstore.='___&___'; }
+ $newstore.=$_.'___=___'.$currentlystored{$_};
+ }
+ my $now=time;
+ if ($stype eq 'studentcalc') {
+ &Apache::lonnet::reply('put:'.
+ $ENV{'course.'.$cid.'.domain'}.':'.
+ $ENV{'course.'.$cid.'.num'}.
+ ':nohist_calculatedsheets:'.
+ &Apache::lonnet::escape($key).'='.
+ &Apache::lonnet::escape($newstore).'&'.
+ &Apache::lonnet::escape($key).'.time='.$now,
+ $ENV{'course.'.$cid.'.home'});
+ } else {
+ &Apache::lonnet::reply('put:'.
+ &getudom($thissheet).':'.
+ &getuname($thissheet).
+ ':nohist_calculatedsheets_'.
+ $ENV{'request.course.id'}.':'.
+ &Apache::lonnet::escape($key).'='.
+ &Apache::lonnet::escape($newstore).'&'.
+ &Apache::lonnet::escape($key).'.time='.$now,
+ &getuhome($thissheet));
+ }
}
- my $now=time;
- if ($stype eq 'studentcalc') {
- &Apache::lonnet::reply('put:'.
- $ENV{'course.'.$cid.'.domain'}.':'.
- $ENV{'course.'.$cid.'.num'}.
- ':nohist_calculatedsheets:'.
- &Apache::lonnet::escape($key).'='.
- &Apache::lonnet::escape($newstore).'&'.
- &Apache::lonnet::escape($key).'.time='.$now,
- $ENV{'course.'.$cid.'.home'});
- } else {
- &Apache::lonnet::reply('put:'.
- &getudom($thissheet).':'.
- &getuname($thissheet).
- ':nohist_calculatedsheets_'.
- $ENV{'request.course.id'}.':'.
- &Apache::lonnet::escape($key).'='.
- &Apache::lonnet::escape($newstore).'&'.
- &Apache::lonnet::escape($key).'.time='.$now,
- &getuhome($thissheet));
- }
- }
- return @exportarr;
+ return @exportarr;
}
+
# ============================================================ Expiration Dates
#
# Load previously cached student spreadsheets for this course
#
-
sub expirationdates {
undef %expiredates;
my $cid=$ENV{'request.course.id'};
@@ -2276,74 +2426,51 @@ sub cachedssheets {
sub handler {
my $r=shift;
-
if ($r->header_only) {
- $r->content_type('text/html');
- $r->send_http_header;
- return OK;
- }
-
-# ---------------------------------------------------- Global directory configs
-
-$includedir=$r->dir_config('lonIncludes');
-$tmpdir=$r->dir_config('lonDaemons').'/tmp/';
-
-# ----------------------------------------------------- Needs to be in a course
-
- if ($ENV{'request.course.fn'}) {
-
-# --------------------------- Get query string for limited number of parameters
-
- foreach (split(/&/,$ENV{'QUERY_STRING'})) {
- my ($name, $value) = split(/=/,$_);
- $value =~ tr/+/ /;
- $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
- if (($name eq 'uname') || ($name eq 'udom') ||
- ($name eq 'usymb') || ($name eq 'ufn')) {
- unless ($ENV{'form.'.$name}) {
- $ENV{'form.'.$name}=$value;
- }
- }
- }
-
- if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {
- $ENV{'form.ufn'}='default_'.$1;
- }
-
-# -------------------------------------- Interactive loading of specific sheet?
- if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {
- $ENV{'form.ufn'}=$ENV{'form.loadthissheet'};
- }
-# ------------------------------------------- Nothing there? Must be login user
-
- my $aname;
- my $adom;
-
- unless ($ENV{'form.uname'}) {
- $aname=$ENV{'user.name'};
- $adom=$ENV{'user.domain'};
- } else {
- $aname=$ENV{'form.uname'};
- $adom=$ENV{'form.udom'};
- }
-
-# ------------------------------------------------------------------- Open page
-
- $r->content_type('text/html');
- $r->header_out('Cache-control','no-cache');
- $r->header_out('Pragma','no-cache');
- $r->send_http_header;
-
-# --------------------------------------------------------------- Screen output
-
- $r->print('