version 1.103, 2002/08/29 15:35:01
|
version 1.104, 2002/08/30 19:47:47
|
Line 142 sub initsheet {
|
Line 142 sub initsheet {
|
# rl: row label |
# rl: row label |
# os: other spreadsheets (for student spreadsheet only) |
# os: other spreadsheets (for student spreadsheet only) |
|
|
undef %v; |
undef %sheet_values; |
undef %t; |
undef %t; |
undef %f; |
undef %f; |
undef %c; |
undef %c; |
undef %rowlabel; |
undef %rowlabel; |
undef @os; |
undef @os; |
|
|
$maxrow=0; |
$maxrow = 0; |
$sheettype=''; |
$sheettype = ''; |
|
|
# filename/reference of the sheet |
# filename/reference of the sheet |
|
$filename = ''; |
$filename=''; |
|
|
|
# user data |
# user data |
$uname=''; |
$uname = ''; |
$uhome=''; |
$uhome = ''; |
$udom=''; |
$udom = ''; |
|
|
# course data |
# course data |
|
|
$csec=''; |
$csec = ''; |
$chome=''; |
$chome= ''; |
$cnum=''; |
$cnum = ''; |
$cdom=''; |
$cdom = ''; |
$cid=''; |
$cid = ''; |
$cfn=''; |
$cfn = ''; |
|
|
# symb |
# symb |
|
|
$usymb=''; |
$usymb = ''; |
|
|
# error messages |
# error messages |
|
$errormsg = ''; |
$errormsg=''; |
|
|
|
sub mask { |
sub mask { |
my ($lower,$upper)=@_; |
my ($lower,$upper)=@_; |
Line 385 sub CDLHASH {
|
Line 383 sub CDLHASH {
|
if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { |
if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { |
my $keymask = &mask($key); |
my $keymask = &mask($key); |
# Assume the keys are addresses |
# Assume the keys are addresses |
my @Temp = grep /$keymask/,keys(%v); |
my @Temp = grep /$keymask/,keys(%sheet_values); |
@Keys = $v{@Temp}; |
@Keys = $sheet_values{@Temp}; |
} else { |
} else { |
$Keys[0]= $key; |
$Keys[0]= $key; |
} |
} |
Line 397 sub CDLHASH {
|
Line 395 sub CDLHASH {
|
@Keys = @Temp; |
@Keys = @Temp; |
if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { |
if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { |
my $valmask = &mask($value); |
my $valmask = &mask($value); |
my @Temp = grep /$valmask/,keys(%v); |
my @Temp = grep /$valmask/,keys(%sheet_values); |
@Values =$v{@Temp}; |
@Values =$sheet_values{@Temp}; |
} else { |
} else { |
$Values[0]= $value; |
$Values[0]= $value; |
} |
} |
Line 432 sub GETHASH {
|
Line 430 sub GETHASH {
|
$index = 0; |
$index = 0; |
} |
} |
if ($key =~ /^[A-z]\d+$/) { |
if ($key =~ /^[A-z]\d+$/) { |
$key = $v{$key}; |
$key = $sheet_values{$key}; |
} |
} |
return $hashes{$name}->{$key}->[$index]; |
return $hashes{$name}->{$key}->[$index]; |
} |
} |
Line 489 sub HASH {
|
Line 487 sub HASH {
|
if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { |
if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { |
my $keymask = &mask($key); |
my $keymask = &mask($key); |
# Assume the keys are addresses |
# Assume the keys are addresses |
my @Temp = grep /$keymask/,keys(%v); |
my @Temp = grep /$keymask/,keys(%sheet_values); |
@Keys = $v{@Temp}; |
@Keys = $sheet_values{@Temp}; |
} else { |
} else { |
$Keys[0]= $key; |
$Keys[0]= $key; |
} |
} |
Line 502 sub HASH {
|
Line 500 sub HASH {
|
# Check to see if we have multiple $value(s) |
# Check to see if we have multiple $value(s) |
if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { |
if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { |
my $valmask = &mask($value); |
my $valmask = &mask($value); |
my @Temp = grep /$valmask/,keys(%v); |
my @Temp = grep /$valmask/,keys(%sheet_values); |
@Values =$v{@Temp}; |
@Values =$sheet_values{@Temp}; |
} else { |
} else { |
$Values[0]= $value; |
$Values[0]= $value; |
} |
} |
Line 532 returns the number of items in the range
|
Line 530 returns the number of items in the range
|
#------------------------------------------------------- |
#------------------------------------------------------- |
sub NUM { |
sub NUM { |
my $mask=mask(@_); |
my $mask=mask(@_); |
my $num= $#{@{grep(/$mask/,keys(%v))}}+1; |
my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1; |
return $num; |
return $num; |
} |
} |
|
|
Line 540 sub BIN {
|
Line 538 sub BIN {
|
my ($low,$high,$lower,$upper)=@_; |
my ($low,$high,$lower,$upper)=@_; |
my $mask=mask($lower,$upper); |
my $mask=mask($lower,$upper); |
my $num=0; |
my $num=0; |
foreach (grep /$mask/,keys(%v)) { |
foreach (grep /$mask/,keys(%sheet_values)) { |
if (($v{$_}>=$low) && ($v{$_}<=$high)) { |
if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) { |
$num++; |
$num++; |
} |
} |
} |
} |
Line 561 returns the sum of items in the range.
|
Line 559 returns the sum of items in the range.
|
sub SUM { |
sub SUM { |
my $mask=mask(@_); |
my $mask=mask(@_); |
my $sum=0; |
my $sum=0; |
foreach (grep /$mask/,keys(%v)) { |
foreach (grep /$mask/,keys(%sheet_values)) { |
$sum+=$v{$_}; |
$sum+=$sheet_values{$_}; |
} |
} |
return $sum; |
return $sum; |
} |
} |
Line 579 compute the average of the items in the
|
Line 577 compute the average of the items in the
|
sub MEAN { |
sub MEAN { |
my $mask=mask(@_); |
my $mask=mask(@_); |
my $sum=0; my $num=0; |
my $sum=0; my $num=0; |
foreach (grep /$mask/,keys(%v)) { |
foreach (grep /$mask/,keys(%sheet_values)) { |
$sum+=$v{$_}; |
$sum+=$sheet_values{$_}; |
$num++; |
$num++; |
} |
} |
if ($num) { |
if ($num) { |
Line 602 compute the standard deviation of the it
|
Line 600 compute the standard deviation of the it
|
sub STDDEV { |
sub STDDEV { |
my $mask=mask(@_); |
my $mask=mask(@_); |
my $sum=0; my $num=0; |
my $sum=0; my $num=0; |
foreach (grep /$mask/,keys(%v)) { |
foreach (grep /$mask/,keys(%sheet_values)) { |
$sum+=$v{$_}; |
$sum+=$sheet_values{$_}; |
$num++; |
$num++; |
} |
} |
unless ($num>1) { return undef; } |
unless ($num>1) { return undef; } |
my $mean=$sum/$num; |
my $mean=$sum/$num; |
$sum=0; |
$sum=0; |
foreach (grep /$mask/,keys(%v)) { |
foreach (grep /$mask/,keys(%sheet_values)) { |
$sum+=($v{$_}-$mean)**2; |
$sum+=($sheet_values{$_}-$mean)**2; |
} |
} |
return sqrt($sum/($num-1)); |
return sqrt($sum/($num-1)); |
} |
} |
Line 627 compute the product of the items in the
|
Line 625 compute the product of the items in the
|
sub PROD { |
sub PROD { |
my $mask=mask(@_); |
my $mask=mask(@_); |
my $prod=1; |
my $prod=1; |
foreach (grep /$mask/,keys(%v)) { |
foreach (grep /$mask/,keys(%sheet_values)) { |
$prod*=$v{$_}; |
$prod*=$sheet_values{$_}; |
} |
} |
return $prod; |
return $prod; |
} |
} |
Line 645 compute the maximum of the items in the
|
Line 643 compute the maximum of the items in the
|
sub MAX { |
sub MAX { |
my $mask=mask(@_); |
my $mask=mask(@_); |
my $max='-'; |
my $max='-'; |
foreach (grep /$mask/,keys(%v)) { |
foreach (grep /$mask/,keys(%sheet_values)) { |
unless ($max) { $max=$v{$_}; } |
unless ($max) { $max=$sheet_values{$_}; } |
if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; } |
if (($sheet_values{$_}>$max) || ($max eq '-')) { $max=$sheet_values{$_}; } |
} |
} |
return $max; |
return $max; |
} |
} |
Line 664 compute the minimum of the items in the
|
Line 662 compute the minimum of the items in the
|
sub MIN { |
sub MIN { |
my $mask=mask(@_); |
my $mask=mask(@_); |
my $min='-'; |
my $min='-'; |
foreach (grep /$mask/,keys(%v)) { |
foreach (grep /$mask/,keys(%sheet_values)) { |
unless ($max) { $max=$v{$_}; } |
unless ($max) { $max=$sheet_values{$_}; } |
if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; } |
if (($sheet_values{$_}<$min) || ($min eq '-')) { |
|
$min=$sheet_values{$_}; |
|
} |
} |
} |
return $min; |
return $min; |
} |
} |
Line 685 sub SUMMAX {
|
Line 685 sub SUMMAX {
|
my ($num,$lower,$upper)=@_; |
my ($num,$lower,$upper)=@_; |
my $mask=mask($lower,$upper); |
my $mask=mask($lower,$upper); |
my @inside=(); |
my @inside=(); |
foreach (grep /$mask/,keys(%v)) { |
foreach (grep /$mask/,keys(%sheet_values)) { |
push (@inside,$v{$_}); |
push (@inside,$sheet_values{$_}); |
} |
} |
@inside=sort(@inside); |
@inside=sort(@inside); |
my $sum=0; my $i; |
my $sum=0; my $i; |
Line 710 sub SUMMIN {
|
Line 710 sub SUMMIN {
|
my ($num,$lower,$upper)=@_; |
my ($num,$lower,$upper)=@_; |
my $mask=mask($lower,$upper); |
my $mask=mask($lower,$upper); |
my @inside=(); |
my @inside=(); |
foreach (grep /$mask/,keys(%v)) { |
foreach (grep /$mask/,keys(%sheet_values)) { |
$inside[$#inside+1]=$v{$_}; |
$inside[$#inside+1]=$sheet_values{$_}; |
} |
} |
@inside=sort(@inside); |
@inside=sort(@inside); |
my $sum=0; my $i; |
my $sum=0; my $i; |
Line 838 sub sett {
|
Line 838 sub sett {
|
} else { |
} else { |
$pattern='[A-Z]'; |
$pattern='[A-Z]'; |
} |
} |
|
# Deal with the template row |
# Deal with the template row |
|
foreach (keys(%f)) { |
foreach (keys(%f)) { |
if ($_=~/template\_(\w)/) { |
next if ($_!~/template\_(\w)/); |
my $col=$1; |
my $col=$1; |
unless ($col=~/^$pattern/) { |
next if ($col=~/^$pattern/); |
foreach (keys(%f)) { |
foreach (keys(%f)) { |
if ($_=~/A(\d+)/) { |
next if ($_!~/A(\d+)/); |
my $trow=$1; |
my $trow=$1; |
if ($trow) { |
next if (! $trow); |
# Get the name of this cell |
# Get the name of this cell |
my $lb=$col.$trow; |
my $lb=$col.$trow; |
# Grab the template declaration |
# Grab the template declaration |
$t{$lb}=$f{'template_'.$col}; |
$t{$lb}=$f{'template_'.$col}; |
# Replace '#' with the row number |
# Replace '#' with the row number |
$t{$lb}=~s/\#/$trow/g; |
$t{$lb}=~s/\#/$trow/g; |
# Replace '....' with ',' |
# Replace '....' with ',' |
$t{$lb}=~s/\.\.+/\,/g; |
$t{$lb}=~s/\.\.+/\,/g; |
# Replace 'A0' with the value from 'A0' |
# Replace 'A0' with the value from 'A0' |
$t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g; |
$t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; |
# Replace parameters |
# Replace parameters |
$t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; |
$t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; |
} |
} |
} |
|
} |
|
} |
|
} |
|
} |
} |
|
# Deal with the normal cells |
# Deal with the normal cells |
|
foreach (keys(%f)) { |
foreach (keys(%f)) { |
if (($f{$_}) && ($_!~/template\_/)) { |
if (($f{$_}) && ($_!~/template\_/)) { |
my $matches=($_=~/^$pattern(\d+)/); |
my $matches=($_=~/^$pattern(\d+)/); |
Line 878 sub sett {
|
Line 872 sub sett {
|
} else { |
} else { |
$t{$_}=$f{$_}; |
$t{$_}=$f{$_}; |
$t{$_}=~s/\.\.+/\,/g; |
$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; |
$t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; |
} |
} |
} |
} |
} |
} |
# For inserted lines, [B-Z] is also valid |
# For inserted lines, [B-Z] is also valid |
|
|
unless ($sheettype eq 'assesscalc') { |
unless ($sheettype eq 'assesscalc') { |
foreach (keys(%f)) { |
foreach (keys(%f)) { |
if ($_=~/[B-Z](\d+)/) { |
if ($_=~/[B-Z](\d+)/) { |
if ($f{'A'.$1}=~/^[\~\-]/) { |
if ($f{'A'.$1}=~/^[\~\-]/) { |
$t{$_}=$f{$_}; |
$t{$_}=$f{$_}; |
$t{$_}=~s/\.\.+/\,/g; |
$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; |
$t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; |
} |
} |
} |
} |
} |
} |
} |
} |
|
|
# For some reason 'A0' gets special treatment... This seems superfluous |
# For some reason 'A0' gets special treatment... This seems superfluous |
# but I imagine it is here for a reason. |
# but I imagine it is here for a reason. |
$t{'A0'}=$f{'A0'}; |
$t{'A0'}=$f{'A0'}; |
$t{'A0'}=~s/\.\.+/\,/g; |
$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; |
$t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; |
} |
} |
|
|
sub calc { |
sub calc { |
undef %v; |
undef %sheet_values; |
&sett(); |
&sett(); |
my $notfinished=1; |
my $notfinished=1; |
my $lastcalc=''; |
my $lastcalc=''; |
Line 915 sub calc {
|
Line 907 sub calc {
|
while ($notfinished) { |
while ($notfinished) { |
$notfinished=0; |
$notfinished=0; |
foreach (keys(%t)) { |
foreach (keys(%t)) { |
my $old=$v{$_}; |
my $old=$sheet_values{$_}; |
$v{$_}=eval $t{$_}; |
$sheet_values{$_}=eval $t{$_}; |
if ($@) { |
if ($@) { |
undef %v; |
undef %sheet_values; |
return $_.': '.$@; |
return $_.': '.$@; |
} |
} |
if ($v{$_} ne $old) { $notfinished=1; $lastcalc=$_; } |
if ($sheet_values{$_} ne $old) { $notfinished=1; $lastcalc=$_; } |
} |
} |
$depth++; |
$depth++; |
if ($depth>100) { |
if ($depth>100) { |
undef %v; |
undef %sheet_values; |
return $lastcalc.': Maximum calculation depth exceeded'; |
return $lastcalc.': Maximum calculation depth exceeded'; |
} |
} |
} |
} |
Line 941 sub templaterow {
|
Line 933 sub templaterow {
|
'n','o','p','q','r','s','t','u','v','w','x','y','z') { |
'n','o','p','q','r','s','t','u','v','w','x','y','z') { |
my $fm=$f{'template_'.$_}; |
my $fm=$f{'template_'.$_}; |
$fm=~s/[\'\"]/\&\#34;/g; |
$fm=~s/[\'\"]/\&\#34;/g; |
$cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm; |
push(@cols,"'template_$_','$fm'".'___eq___'.$fm); |
} |
} |
return @cols; |
return @cols; |
} |
} |
|
|
|
# |
|
# This is actually used for the student spreadsheet, not the assessment sheet |
|
# Do not be fooled by the name! |
|
# |
sub outrowassess { |
sub outrowassess { |
|
# $n is the current row number |
my $n=shift; |
my $n=shift; |
my @cols=(); |
my @cols=(); |
if ($n) { |
if ($n) { |
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n}); |
my ($usy,$ufn)=split(/__&&&\__/,$f{'A'.$n}); |
if ($rowlabel{$usy}) { |
if ($rowlabel{$usy}) { |
$cols[0]=$rowlabel{$usy}.'<br>'. |
$cols[0]=$rowlabel{$usy}.'<br>'. |
'<select name="sel_'.$n.'" onChange="changesheet('.$n. |
'<select name="sel_'.$n.'" onChange="changesheet('.$n.')">'. |
')"><option name="default">Default</option>'; |
'<option name="default">Default</option>'; |
} else { $cols[0]=''; } |
} else { |
foreach (@os) { |
$cols[0]=''; |
$cols[0].='<option name="'.$_.'"'; |
} |
|
foreach (@os) { |
|
$cols[0].='<option name="'.$_.'"'; |
if ($ufn eq $_) { |
if ($ufn eq $_) { |
$cols[0].=' selected'; |
$cols[0].=' selected'; |
} |
} |
$cols[0].='>'.$_.'</option>'; |
$cols[0].='>'.$_.'</option>'; |
} |
} |
$cols[0].='</select>'; |
$cols[0].='</select>'; |
} else { |
} else { |
$cols[0]='<b><font size=+1>Export</font></b>'; |
$cols[0]='<b><font size=+1>Export</font></b>'; |
} |
} |
foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
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', |
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', |
Line 973 sub outrowassess {
|
Line 972 sub outrowassess {
|
'n','o','p','q','r','s','t','u','v','w','x','y','z') { |
'n','o','p','q','r','s','t','u','v','w','x','y','z') { |
my $fm=$f{$_.$n}; |
my $fm=$f{$_.$n}; |
$fm=~s/[\'\"]/\&\#34;/g; |
$fm=~s/[\'\"]/\&\#34;/g; |
push(@cols,"'$_$n','$fm'".'___eq___'.$v{$_.$n}); |
push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n}); |
} |
} |
return @cols; |
return @cols; |
} |
} |
Line 992 sub outrow {
|
Line 991 sub outrow {
|
'n','o','p','q','r','s','t','u','v','w','x','y','z') { |
'n','o','p','q','r','s','t','u','v','w','x','y','z') { |
my $fm=$f{$_.$n}; |
my $fm=$f{$_.$n}; |
$fm=~s/[\'\"]/\&\#34;/g; |
$fm=~s/[\'\"]/\&\#34;/g; |
$cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n}; |
push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n}); |
} |
} |
return @cols; |
return @cols; |
} |
} |
Line 1001 sub exportrowa {
|
Line 1000 sub exportrowa {
|
my @exportarray=(); |
my @exportarray=(); |
foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
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') { |
'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; |
return @exportarray; |
} |
} |
Line 1051 sub calcsheet {
|
Line 1050 sub calcsheet {
|
|
|
sub getvalues { |
sub getvalues { |
my $safeeval=shift; |
my $safeeval=shift; |
return $safeeval->reval('%v'); |
return $safeeval->reval('%sheet_values'); |
} |
} |
|
|
# ---------------------------------------------------------------- Get formulas |
# ---------------------------------------------------------------- Get formulas |
Line 1220 sub rown {
|
Line 1219 sub rown {
|
$maxred=26; |
$maxred=26; |
} |
} |
if (&getfa($safeeval,$n)=~/^[\~\-]/) { $maxred=1; } |
if (&getfa($safeeval,$n)=~/^[\~\-]/) { $maxred=1; } |
if ($n eq '-') { $proc='&templaterow'; $n=-1; $dataflag=1; } |
if ($n eq '-') { |
|
$proc='&templaterow'; |
|
$n=-1; |
|
$dataflag=1; |
|
} |
foreach ($safeeval->reval($proc.'('.$n.')')) { |
foreach ($safeeval->reval($proc.'('.$n.')')) { |
my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD'); |
my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD'); |
my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_); |
my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_); |
Line 1339 sub outsheet {
|
Line 1342 sub outsheet {
|
sub othersheets { |
sub othersheets { |
my ($safeeval,$stype)=@_; |
my ($safeeval,$stype)=@_; |
# |
# |
my $cnum=&getcnum($safeeval); |
my $cnum = &getcnum($safeeval); |
my $cdom=&getcdom($safeeval); |
my $cdom = &getcdom($safeeval); |
my $chome=&getchome($safeeval); |
my $chome = &getchome($safeeval); |
# |
# |
my @alternatives=(); |
my @alternatives=(); |
my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum); |
my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum); |
Line 1386 sub parse_sheet {
|
Line 1389 sub parse_sheet {
|
# |
# |
|
|
sub readsheet { |
sub readsheet { |
my ($safeeval,$fn)=@_; |
my ($safeeval,$fn)=@_; |
my $stype=&gettype($safeeval); |
my $stype = &gettype($safeeval); |
my $cnum=&getcnum($safeeval); |
my $cnum = &getcnum($safeeval); |
my $cdom=&getcdom($safeeval); |
my $cdom = &getcdom($safeeval); |
my $chome=&getchome($safeeval); |
my $chome = &getchome($safeeval); |
|
|
if (! defined($fn)) { |
if (! defined($fn)) { |
# There is no filename. Look for defaults in course and global, cache |
# There is no filename. Look for defaults in course and global, cache |
unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) { |
unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) { |
my %tmphash = &Apache::lonnet::get('environment', |
my %tmphash = &Apache::lonnet::get('environment', |
['spreadsheet_default_'.$stype], |
['spreadsheet_default_'.$stype], |
$cdom,$cnum); |
$cdom,$cnum); |
my ($tmp) = keys(%tmphash); |
my ($tmp) = keys(%tmphash); |
if ($tmp =~ /^(con_lost|error|no_such_host)/i) { |
if ($tmp =~ /^(con_lost|error|no_such_host)/i) { |
$fn = 'default_'.$stype; |
$fn = 'default_'.$stype; |
} else { |
} else { |
$fn = $tmphash{'spreadsheet_default_'.$stype}; |
$fn = $tmphash{'spreadsheet_default_'.$stype}; |
} |
} |
unless (($fn) && ($fn!~/^error\:/)) { |
unless (($fn) && ($fn!~/^error\:/)) { |
$fn='default_'.$stype; |
$fn='default_'.$stype; |
} |
} |
$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; |
$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; |
} |
} |
} |
} |
|
# $fn now has a value |
# ---------------------------------------------------------- fn now has a value |
&setfilename($safeeval,$fn); |
|
# see if sheet is cached |
&setfilename($safeeval,$fn); |
my $fstring=''; |
|
if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) { |
# ------------------------------------------------------ see if sheet is cached |
&setformulas($safeeval,split(/\_\_\_\;\_\_\_/,$fstring)); |
my $fstring=''; |
} else { |
if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) { |
# Not cached, need to read |
&setformulas($safeeval,split(/\_\_\_\;\_\_\_/,$fstring)); |
my %f=(); |
} else { |
if ($fn=~/^default\_/) { |
|
my $sheetxml=''; |
# ---------------------------------------------------- Not cached, need to read |
my $fh; |
|
my $dfn=$fn; |
my %f=(); |
$dfn=~s/\_/\./g; |
|
if ($fh=Apache::File->new($includedir.'/'.$dfn)) { |
if ($fn=~/^default\_/) { |
$sheetxml=join('',<$fh>); |
my $sheetxml=''; |
} else { |
my $fh; |
$sheetxml='<field row="0" col="A">"Error"</field>'; |
my $dfn=$fn; |
} |
$dfn=~s/\_/\./g; |
%f=%{&parse_sheet(\$sheetxml)}; |
if ($fh=Apache::File->new($includedir.'/'.$dfn)) { |
} elsif($fn=~/\/*\.spreadsheet$/) { |
$sheetxml=join('',<$fh>); |
my $sheetxml=&Apache::lonnet::getfile |
} else { |
(&Apache::lonnet::filelocation('',$fn)); |
$sheetxml='<field row="0" col="A">"Error"</field>'; |
if ($sheetxml == -1) { |
} |
$sheetxml='<field row="0" col="A">"Error loading spreadsheet ' |
%f=%{&parse_sheet(\$sheetxml)}; |
.$fn.'"</field>'; |
} elsif($fn=~/\/*\.spreadsheet$/) { |
} |
my $sheetxml=&Apache::lonnet::getfile |
%f=%{&parse_sheet(\$sheetxml)}; |
(&Apache::lonnet::filelocation('',$fn)); |
} else { |
if ($sheetxml == -1) { |
my $sheet=''; |
$sheetxml='<field row="0" col="A">"Error loading spreadsheet ' |
my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum); |
.$fn.'"</field>'; |
my ($tmp) = keys(%tmphash); |
} |
unless ($tmp =~ /^(con_lost|error|no_such_host)/i) { |
%f=%{&parse_sheet(\$sheetxml)}; |
foreach (keys(%tmphash)) { |
} else { |
$f{$_}=$tmphash{$_}; |
my $sheet=''; |
} |
my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum); |
} |
my ($tmp) = keys(%tmphash); |
} |
unless ($tmp =~ /^(con_lost|error|no_such_host)/i) { |
# Cache and set |
foreach (keys(%tmphash)) { |
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); |
$f{$_}=$tmphash{$_}; |
&setformulas($safeeval,%f); |
} |
|
} |
|
} |
|
# --------------------------------------------------------------- Cache and set |
|
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); |
|
&setformulas($safeeval,%f); |
|
} |
} |
} |
} |
|
|
Line 1484 sub makenewsheet {
|
Line 1481 sub makenewsheet {
|
# ------------------------------------------------------------ Save spreadsheet |
# ------------------------------------------------------------ Save spreadsheet |
|
|
sub writesheet { |
sub writesheet { |
my ($safeeval,$makedef)=@_; |
my ($safeeval,$makedef)=@_; |
my $cid=&getcid($safeeval); |
my $cid=&getcid($safeeval); |
if (&Apache::lonnet::allowed('opa',$cid)) { |
if (&Apache::lonnet::allowed('opa',$cid)) { |
my %f=&getformulas($safeeval); |
my %f=&getformulas($safeeval); |
my $stype=&gettype($safeeval); |
my $stype=&gettype($safeeval); |
my $cnum=&getcnum($safeeval); |
my $cnum=&getcnum($safeeval); |
my $cdom=&getcdom($safeeval); |
my $cdom=&getcdom($safeeval); |
my $chome=&getchome($safeeval); |
my $chome=&getchome($safeeval); |
my $fn=&getfilename($safeeval); |
my $fn=&getfilename($safeeval); |
|
# Cache new sheet |
# ------------------------------------------------------------- Cache new sheet |
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); |
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); |
# Write sheet |
# ----------------------------------------------------------------- Write sheet |
my $sheetdata=''; |
my $sheetdata=''; |
foreach (keys(%f)) { |
foreach (keys(%f)) { |
unless ($f{$_} eq 'import') { |
unless ($f{$_} eq 'import') { |
$sheetdata.=&Apache::lonnet::escape($_).'='. |
$sheetdata.=&Apache::lonnet::escape($_).'='. |
&Apache::lonnet::escape($f{$_}).'&'; |
&Apache::lonnet::escape($f{$_}).'&'; |
} |
} |
} |
} |
$sheetdata=~s/\&$//; |
$sheetdata=~s/\&$//; |
my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'. |
my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'. |
$sheetdata,$chome); |
$sheetdata,$chome); |
if ($reply eq 'ok') { |
if ($reply eq 'ok') { |
$reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'. |
$reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'. |
$stype.'_spreadsheets:'. |
$stype.'_spreadsheets:'. |
&Apache::lonnet::escape($fn). |
&Apache::lonnet::escape($fn).'='.$ENV{'user.name'}.'@'. |
'='.$ENV{'user.name'}.'@'. |
$ENV{'user.domain'}, |
$ENV{'user.domain'}, |
$chome); |
$chome); |
if ($reply eq 'ok') { |
if ($reply eq 'ok') { |
if ($makedef) { |
if ($makedef) { |
return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum. |
return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum. |
':environment:spreadsheet_default_'.$stype.'='. |
':environment:'. |
&Apache::lonnet::escape($fn), |
'spreadsheet_default_'. |
$chome); |
$stype.'='. |
} else { |
&Apache::lonnet::escape($fn), |
return $reply; |
$chome); |
} |
} |
} else { |
return $reply; |
return $reply; |
} |
} |
return $reply; |
} else { |
} |
return $reply; |
return $reply; |
} |
} |
} |
return 'unauthorized'; |
return 'unauthorized'; |
|
} |
} |
|
|
# ----------------------------------------------- Make a temp copy of the sheet |
# ----------------------------------------------- Make a temp copy of the sheet |
Line 1539 sub writesheet {
|
Line 1535 sub writesheet {
|
sub tmpwrite { |
sub tmpwrite { |
my $safeeval=shift; |
my $safeeval=shift; |
my $fn=$ENV{'user.name'}.'_'. |
my $fn=$ENV{'user.name'}.'_'. |
$ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'. |
$ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'. |
&getfilename($safeeval); |
&getfilename($safeeval); |
$fn=~s/\W/\_/g; |
$fn=~s/\W/\_/g; |
$fn=$tmpdir.$fn.'.tmp'; |
$fn=$tmpdir.$fn.'.tmp'; |
Line 1594 sub tmpread {
|
Line 1590 sub tmpread {
|
&setformulas($safeeval,%fo); |
&setformulas($safeeval,%fo); |
} |
} |
|
|
# ================================================================== Parameters |
################################################## |
# -------------------------------------------- Figure out a cascading parameter |
################################################## |
# |
|
# For this function to work |
|
# |
|
# * parmhash needs to be tied |
|
# * courseopt and useropt need to be initialized for this user and course |
|
# |
|
|
|
sub parmval { |
=pod |
my ($what,$safeeval)=@_; |
|
my $cid=&getcid($safeeval); |
|
my $csec=&getcsec($safeeval); |
|
my $uname=&getuname($safeeval); |
|
my $udom=&getudom($safeeval); |
|
my $symb=&getusymb($safeeval); |
|
|
|
unless ($symb) { return ''; } |
|
my $result=''; |
|
|
|
my ($mapname,$id,$fn)=split(/\_\_\_/,$symb); |
|
# ----------------------------------------------------- Cascading lookup scheme |
|
my $rwhat=$what; |
|
$what=~s/^parameter\_//; |
|
$what=~s/\_([^\_]+)$/\.$1/; |
|
|
|
my $symbparm=$symb.'.'.$what; |
|
my $mapparm=$mapname.'___(all).'.$what; |
|
my $usercourseprefix=$uname.'_'.$udom.'_'.$cid; |
|
|
|
my $seclevel= |
|
$usercourseprefix.'.['. |
|
$csec.'].'.$what; |
|
my $seclevelr= |
|
$usercourseprefix.'.['. |
|
$csec.'].'.$symbparm; |
|
my $seclevelm= |
|
$usercourseprefix.'.['. |
|
$csec.'].'.$mapparm; |
|
|
|
my $courselevel= |
|
$usercourseprefix.'.'.$what; |
|
my $courselevelr= |
|
$usercourseprefix.'.'.$symbparm; |
|
my $courselevelm= |
|
$usercourseprefix.'.'.$mapparm; |
|
|
|
# ---------------------------------------------------------- fourth, check user |
|
|
|
if ($uname) { |
|
|
|
if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; } |
|
|
|
if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; } |
|
|
|
if ($useropt{$courselevel}) { return $useropt{$courselevel}; } |
|
|
|
} |
|
|
|
# --------------------------------------------------------- third, check course |
|
|
|
if ($csec) { |
|
|
|
if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; } |
|
|
|
if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; } |
|
|
|
if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; } |
|
|
|
} |
|
|
|
if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; } |
=item &parmval() |
|
|
if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; } |
Determine the value of a parameter. |
|
|
if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; } |
Inputs: $what, the parameter needed, $safeeval, the safe space |
|
|
# ----------------------------------------------------- second, check map parms |
Returns: The value of a parameter, or '' if none. |
|
|
my $thisparm=$parmhash{$symbparm}; |
This function cascades through the possible levels searching for a value for |
if ($thisparm) { return $thisparm; } |
a parameter. The levels are checked in the following order: |
|
user, course (at section level and course level), map, and lonnet::metadata. |
|
This function uses %parmhash, which must be tied prior to calling it. |
|
This function also requires %courseopt and %useropt to be initialized for |
|
this user and course. |
|
|
# -------------------------------------------------------- first, check default |
=cut |
|
|
return &Apache::lonnet::metadata($fn,$rwhat.'.default'); |
################################################## |
|
################################################## |
|
sub parmval { |
|
my ($what,$safeeval)=@_; |
|
my $symb = &getusymb($safeeval); |
|
unless ($symb) { return ''; } |
|
# |
|
my $cid = &getcid($safeeval); |
|
my $csec = &getcsec($safeeval); |
|
my $uname = &getuname($safeeval); |
|
my $udom = &getudom($safeeval); |
|
my $result=''; |
|
# |
|
my ($mapname,$id,$fn)=split(/\_\_\_/,$symb); |
|
# Cascading lookup scheme |
|
my $rwhat=$what; |
|
$what =~ s/^parameter\_//; |
|
$what =~ s/\_([^\_]+)$/\.$1/; |
|
# |
|
my $symbparm = $symb.'.'.$what; |
|
my $mapparm = $mapname.'___(all).'.$what; |
|
my $usercourseprefix = $uname.'_'.$udom.'_'.$cid; |
|
# |
|
my $seclevel = $usercourseprefix.'.['.$csec.'].'.$what; |
|
my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm; |
|
my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm; |
|
# |
|
my $courselevel = $usercourseprefix.'.'.$what; |
|
my $courselevelr = $usercourseprefix.'.'.$symbparm; |
|
my $courselevelm = $usercourseprefix.'.'.$mapparm; |
|
# fourth, check user |
|
if ($uname) { |
|
return $useropt{$courselevelr} if ($useropt{$courselevelr}); |
|
return $useropt{$courselevelm} if ($useropt{$courselevelm}); |
|
return $useropt{$courselevel} if ($useropt{$courselevel}); |
|
} |
|
# third, check course |
|
if ($csec) { |
|
return $courseopt{$seclevelr} if ($courseopt{$seclevelr}); |
|
return $courseopt{$seclevelm} if ($courseopt{$seclevelm}); |
|
return $courseopt{$seclevel} if ($courseopt{$seclevel}); |
|
} |
|
# |
|
return $courseopt{$courselevelr} if ($courseopt{$courselevelr}); |
|
return $courseopt{$courselevelm} if ($courseopt{$courselevelm}); |
|
return $courseopt{$courselevel} if ($courseopt{$courselevel}); |
|
# second, check map parms |
|
my $thisparm = $parmhash{$symbparm}; |
|
return $thisparm if ($thisparm); |
|
# first, check default |
|
return &Apache::lonnet::metadata($fn,$rwhat.'.default'); |
} |
} |
|
|
# ---------------------------------------------- Update rows for course listing |
# ---------------------------------------------- Update rows for course listing |
|
|
sub updateclasssheet { |
sub updateclasssheet { |
my $safeeval=shift; |
my $safeeval=shift; |
my $cnum=&getcnum($safeeval); |
my $cnum=&getcnum($safeeval); |
Line 1788 sub updateclasssheet {
|
Line 1770 sub updateclasssheet {
|
} |
} |
|
|
# ----------------------------------- Update rows for student and assess sheets |
# ----------------------------------- Update rows for student and assess sheets |
|
|
sub updatestudentassesssheet { |
sub updatestudentassesssheet { |
my $safeeval=shift; |
my $safeeval=shift; |
my %bighash; |
my %bighash; |
my $stype=&gettype($safeeval); |
my $stype=&gettype($safeeval); |
my %current=(); |
my %current=(); |
unless ($updatedata{$ENV{'request.course.fn'}.'_'.$stype}) { |
if ($updatedata{$ENV{'request.course.fn'}.'_'.$stype}) { |
# -------------------------------------------------------------------- Tie hash |
%current=split(/\_\_\_\;\_\_\_/, |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
$updatedata{$ENV{'request.course.fn'}.'_'.$stype}); |
&GDBM_READER(),0640)) { |
} else { |
# --------------------------------------------------------- Get all assessments |
# Tie hash |
|
tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
my %allkeys=('timestamp' => |
&GDBM_READER(),0640); |
|
if (! tied(%bighash)) { |
|
return 'Could not access course data'; |
|
} |
|
# Get all assessments |
|
my %allkeys=('timestamp' => |
'Timestamp of Last Transaction<br>timestamp', |
'Timestamp of Last Transaction<br>timestamp', |
'subnumber' => |
'subnumber' => |
'Number of Submissions<br>subnumber', |
'Number of Submissions<br>subnumber', |
Line 1808 sub updatestudentassesssheet {
|
Line 1794 sub updatestudentassesssheet {
|
'Number of Tutor Responses<br>tutornumber', |
'Number of Tutor Responses<br>tutornumber', |
'totalpoints' => |
'totalpoints' => |
'Total Points Granted<br>totalpoints'); |
'Total Points Granted<br>totalpoints'); |
|
|
my $adduserstr=''; |
my $adduserstr=''; |
if ((&getuname($safeeval) ne $ENV{'user.name'}) || |
if ((&getuname($safeeval) ne $ENV{'user.name'}) || |
(&getudom($safeeval) ne $ENV{'user.domain'})) { |
(&getudom($safeeval) ne $ENV{'user.domain'})) { |
$adduserstr='&uname='.&getuname($safeeval). |
$adduserstr='&uname='.&getuname($safeeval). |
'&udom='.&getudom($safeeval); |
'&udom='.&getudom($safeeval); |
} |
} |
|
my %allassess = |
my %allassess=('_feedback' => |
('_feedback' =>'<a href="/adm/assesscalc?usymb=_feedback'. |
'<a href="/adm/assesscalc?usymb=_feedback'.$adduserstr. |
$adduserstr.'">Feedback</a>', |
'">Feedback</a>', |
'_evaluation' =>'<a href="/adm/assesscalc?usymb=_evaluation'. |
'_evaluation' => |
$adduserstr.'">Evaluation</a>', |
'<a href="/adm/assesscalc?usymb=_evaluation'.$adduserstr. |
'_tutoring' =>'<a href="/adm/assesscalc?usymb=_tutoring'. |
'">Evaluation</a>', |
$adduserstr.'">Tutoring</a>', |
'_tutoring' => |
'_discussion' =>'<a href="/adm/assesscalc?usymb=_discussion'. |
'<a href="/adm/assesscalc?usymb=_tutoring'.$adduserstr. |
$adduserstr.'">Discussion</a>' |
'">Tutoring</a>', |
); |
'_discussion' => |
|
'<a href="/adm/assesscalc?usymb=_discussion'.$adduserstr. |
|
'">Discussion</a>' |
|
); |
|
|
|
foreach (keys(%bighash)) { |
foreach (keys(%bighash)) { |
if ($_=~/^src\_(\d+)\.(\d+)$/) { |
next if ($_!~/^src\_(\d+)\.(\d+)$/); |
my $mapid=$1; |
my $mapid=$1; |
my $resid=$2; |
my $resid=$2; |
my $id=$mapid.'.'.$resid; |
my $id=$mapid.'.'.$resid; |
my $srcf=$bighash{$_}; |
my $srcf=$bighash{$_}; |
if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { |
if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { |
my $symb= |
my $symb= |
&Apache::lonnet::declutter($bighash{'map_id_'.$mapid}). |
&Apache::lonnet::declutter($bighash{'map_id_'.$mapid}). |
'___'.$resid.'___'. |
'___'.$resid.'___'.&Apache::lonnet::declutter($srcf); |
&Apache::lonnet::declutter($srcf); |
$allassess{$symb}= |
$allassess{$symb}= |
'<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'. |
'<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'. |
$bighash{'title_'.$id}.'</a>'; |
$bighash{'title_'.$id}.'</a>'; |
next if ($stype ne 'assesscalc'); |
if ($stype eq 'assesscalc') { |
foreach my $key (split(/\,/, |
foreach (split(/\,/, |
&Apache::lonnet::metadata($srcf,'keys') |
&Apache::lonnet::metadata($srcf,'keys'))) { |
)) { |
if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) { |
next if ($key !~ /^(stores|parameter)_/); |
my $key=$_; |
my $display= |
my $display= |
&Apache::lonnet::metadata($srcf,$key.'.display'); |
&Apache::lonnet::metadata($srcf,$key.'.display'); |
unless ($display) { |
unless ($display) { |
$display.= |
$display.= |
&Apache::lonnet::metadata($srcf,$key.'.name'); |
&Apache::lonnet::metadata($srcf,$key.'.name'); |
} |
} |
$display.='<br>'.$key; |
$display.='<br>'.$key; |
$allkeys{$key}=$display; |
$allkeys{$key}=$display; |
} # end of foreach |
} |
} |
} # end of foreach |
|
} |
|
} |
|
} |
|
} # end of foreach (keys(%bighash)) |
} # end of foreach (keys(%bighash)) |
untie(%bighash); |
untie(%bighash); |
|
# |
# |
# %allkeys has a list of storage and parameter displays by unikey |
# %allkeys has a list of storage and parameter displays by unikey |
# %allassess has a list of all resource displays by symb |
# %allassess has a list of all resource displays by symb |
# |
# |
|
|
|
if ($stype eq 'assesscalc') { |
if ($stype eq 'assesscalc') { |
%current=%allkeys; |
%current=%allkeys; |
} elsif ($stype eq 'studentcalc') { |
} elsif ($stype eq 'studentcalc') { |
%current=%allassess; |
%current=%allassess; |
} |
} |
$updatedata{$ENV{'request.course.fn'}.'_'.$stype}= |
$updatedata{$ENV{'request.course.fn'}.'_'.$stype}= |
join('___;___',%current); |
join('___;___',%current); |
} else { |
# Get current from cache |
return 'Could not access course data'; |
|
} |
|
# ------------------------------------------------------ Get current from cache |
|
} else { |
|
%current=split(/\_\_\_\;\_\_\_/, |
|
$updatedata{$ENV{'request.course.fn'}.'_'.$stype}); |
|
} |
} |
# -------------------- Find discrepancies between the course row table and this |
# Find discrepancies between the course row table and this |
# |
# |
my %f=&getformulas($safeeval); |
my %f=&getformulas($safeeval); |
my $changed=0; |
my $changed=0; |
|
|
my $maxrow=0; |
my $maxrow=0; |
my %existing=(); |
my %existing=(); |
|
# Now obsolete rows |
# ----------------------------------------------------------- Now obsolete rows |
foreach (keys(%f)) { |
foreach (keys(%f)) { |
next if ($_!~/^A(\d+)/); |
if ($_=~/^A(\d+)/) { |
$maxrow=($1>$maxrow)?$1:$maxrow; |
$maxrow=($1>$maxrow)?$1:$maxrow; |
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_}); |
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_}); |
$existing{$usy}=1; |
$existing{$usy}=1; |
unless ((defined($current{$usy})) || (!$1) || |
unless ((defined($current{$usy})) || (!$1) || |
($f{$_}=~/^(\~\~\~|\-\-\-)/)){ |
($f{$_}=~/^(\~\~\~|\-\-\-)/)){ |
$f{$_}='!!! Obsolete'; |
$f{$_}='!!! Obsolete'; |
$changed=1; |
$changed=1; |
} elsif ($ufn) { |
} elsif ($ufn) { |
$current{$usy} |
$current{$usy} |
=~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/; |
=~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/; |
|
} |
|
} |
|
} |
} |
|
} |
# -------------------------------------------------------- New and unknown keys |
# New and unknown keys |
|
foreach (keys(%current)) { |
foreach (keys(%current)) { |
unless ($existing{$_}) { |
unless ($existing{$_}) { |
$changed=1; |
$changed=1; |
$maxrow++; |
$maxrow++; |
$f{'A'.$maxrow}=$_; |
$f{'A'.$maxrow}=$_; |
|
} |
|
} |
} |
|
} |
if ($changed) { &setformulas($safeeval,%f); } |
if ($changed) { &setformulas($safeeval,%f); } |
|
&setmaxrow($safeeval,$maxrow); |
&setmaxrow($safeeval,$maxrow); |
&setrowlabels($safeeval,%current); |
&setrowlabels($safeeval,%current); |
# |
|
undef %current; |
undef %current; |
undef %existing; |
undef %existing; |
|
} |
} |
|
|
# ------------------------------------------------ Load data for one assessment |
# ------------------------------------------------ Load data for one assessment |
Line 1948 sub loadstudent {
|
Line 1910 sub loadstudent {
|
# |
# |
my @assessdata=(); |
my @assessdata=(); |
foreach (keys(%f)) { |
foreach (keys(%f)) { |
if ($_=~/^A(\d+)/) { |
next if ($_!~/^A(\d+)/); |
my $row=$1; |
my $row=$1; |
unless (($f{$_}=~/^[\!\~\-]/) || ($row==0)) { |
next if (($f{$_}=~/^[\!\~\-]/) || ($row==0)); |
my ($usy,$ufn)=split(/__&&&\__/,$f{$_}); |
my ($usy,$ufn)=split(/__&&&\__/,$f{$_}); |
@assessdata=&exportsheet(&getuname($safeeval), |
@assessdata=&exportsheet(&getuname($safeeval), |
&getudom($safeeval), |
&getudom($safeeval), |
'assesscalc',$usy,$ufn); |
'assesscalc',$usy,$ufn); |
my $index=0; |
my $index=0; |
foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
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') { |
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { |
if ($assessdata[$index]) { |
if ($assessdata[$index]) { |
my $col=$_; |
my $col=$_; |
if ($assessdata[$index]=~/\D/) { |
if ($assessdata[$index]=~/\D/) { |
$c{$col.$row}="'".$assessdata[$index]."'"; |
$c{$col.$row}="'".$assessdata[$index]."'"; |
} else { |
} else { |
$c{$col.$row}=$assessdata[$index]; |
$c{$col.$row}=$assessdata[$index]; |
} |
} |
unless ($col eq 'A') { |
unless ($col eq 'A') { |
$f{$col.$row}='import'; |
$f{$col.$row}='import'; |
} |
} |
} |
} |
$index++; |
$index++; |
} |
|
} |
|
} |
} |
} |
} |
$cachedassess=''; |
$cachedassess=''; |
Line 2007 sub loadcourse {
|
Line 1967 sub loadcourse {
|
ENDPOP |
ENDPOP |
$r->rflush(); |
$r->rflush(); |
foreach (keys(%f)) { |
foreach (keys(%f)) { |
if ($_=~/^A(\d+)/) { |
next if ($_!~/^A(\d+)/); |
my $row=$1; |
my $row=$1; |
unless (($f{$_}=~/^[\!\~\-]/) || ($row==0)) { |
next if (($f{$_}=~/^[\!\~\-]/) || ($row==0)); |
my @studentdata=&exportsheet(split(/\:/,$f{$_}), |
my @studentdata=&exportsheet(split(/\:/,$f{$_}), |
'studentcalc'); |
'studentcalc'); |
undef %userrdatas; |
undef %userrdatas; |
$now++; |
$now++; |
$r->print('<script>popwin.document.popremain.remaining.value="'. |
$r->print('<script>popwin.document.popremain.remaining.value="'. |
$now.'/'.$total.': '.int((time-$since)/$now*($total-$now)). |
$now.'/'.$total.': '.int((time-$since)/$now*($total-$now)). |
' secs remaining";</script>'); |
' secs remaining";</script>'); |
$r->rflush(); |
$r->rflush(); |
|
# |
my $index=0; |
my $index=0; |
foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
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') { |
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { |
if ($studentdata[$index]) { |
if ($studentdata[$index]) { |
my $col=$_; |
my $col=$_; |
if ($studentdata[$index]=~/\D/) { |
if ($studentdata[$index]=~/\D/) { |
$c{$col.$row}="'".$studentdata[$index]."'"; |
$c{$col.$row}="'".$studentdata[$index]."'"; |
} else { |
} else { |
$c{$col.$row}=$studentdata[$index]; |
$c{$col.$row}=$studentdata[$index]; |
} |
} |
unless ($col eq 'A') { |
unless ($col eq 'A') { |
$f{$col.$row}='import'; |
$f{$col.$row}='import'; |
} |
} |
} |
$index++; |
$index++; |
} |
} |
|
} |
|
} |
} |
} |
} |
&setformulas($safeeval,%f); |
&setformulas($safeeval,%f); |
Line 2049 ENDPOP
|
Line 2007 ENDPOP
|
sub loadassessment { |
sub loadassessment { |
my $safeeval=shift; |
my $safeeval=shift; |
|
|
my $uhome=&getuhome($safeeval); |
my $uhome = &getuhome($safeeval); |
my $uname=&getuname($safeeval); |
my $uname = &getuname($safeeval); |
my $udom=&getudom($safeeval); |
my $udom = &getudom($safeeval); |
my $symb=&getusymb($safeeval); |
my $symb = &getusymb($safeeval); |
my $cid=&getcid($safeeval); |
my $cid = &getcid($safeeval); |
my $cnum=&getcnum($safeeval); |
my $cnum = &getcnum($safeeval); |
my $cdom=&getcdom($safeeval); |
my $cdom = &getcdom($safeeval); |
my $chome=&getchome($safeeval); |
my $chome = &getchome($safeeval); |
|
|
my $namespace; |
my $namespace; |
unless ($namespace=$cid) { return ''; } |
unless ($namespace=$cid) { return ''; } |
|
# Get stored values |
# ----------------------------------------------------------- Get stored values |
my %returnhash=(); |
|
if ($cachedassess eq $uname.':'.$udom) { |
my %returnhash=(); |
# |
|
# get data out of the dumped stores |
if ($cachedassess eq $uname.':'.$udom) { |
# |
# |
my $version=$cachedstores{'version:'.$symb}; |
# get data out of the dumped stores |
my $scope; |
# |
for ($scope=1;$scope<=$version;$scope++) { |
|
foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) { |
my $version=$cachedstores{'version:'.$symb}; |
$returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_}; |
my $scope; |
} |
for ($scope=1;$scope<=$version;$scope++) { |
} |
foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) { |
} else { |
$returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_}; |
# |
} |
# restore individual |
} |
# |
|
my $answer=&Apache::lonnet::reply( |
} else { |
"restore:$udom:$uname:". |
# |
&Apache::lonnet::escape($namespace).":". |
# restore individual |
&Apache::lonnet::escape($symb),$uhome); |
# |
foreach (split(/\&/,$answer)) { |
|
my ($name,$value)=split(/\=/,$_); |
my $answer=&Apache::lonnet::reply( |
$returnhash{&Apache::lonnet::unescape($name)}= |
"restore:$udom:$uname:". |
&Apache::lonnet::unescape($value); |
&Apache::lonnet::escape($namespace).":". |
} |
&Apache::lonnet::escape($symb),$uhome); |
my $version; |
foreach (split(/\&/,$answer)) { |
for ($version=1;$version<=$returnhash{'version'};$version++) { |
my ($name,$value)=split(/\=/,$_); |
foreach (split(/\:/,$returnhash{$version.':keys'})) { |
$returnhash{&Apache::lonnet::unescape($name)}= |
$returnhash{$_}=$returnhash{$version.':'.$_}; |
&Apache::lonnet::unescape($value); |
} |
} |
} |
my $version; |
|
for ($version=1;$version<=$returnhash{'version'};$version++) { |
|
foreach (split(/\:/,$returnhash{$version.':keys'})) { |
|
$returnhash{$_}=$returnhash{$version.':'.$_}; |
|
} |
|
} |
} |
} |
# returnhash now has all stores for this resource |
# ----------------------------- returnhash now has all stores for this resource |
# convert all "_" to "." to be able to use libraries, multiparts, etc |
|
|
# --------- convert all "_" to "." to be able to use libraries, multiparts, etc |
|
|
|
my @oldkeys=keys %returnhash; |
my @oldkeys=keys %returnhash; |
|
|
foreach (@oldkeys) { |
foreach (@oldkeys) { |
Line 2112 sub loadassessment {
|
Line 2062 sub loadassessment {
|
$name=~s/\_/\./g; |
$name=~s/\_/\./g; |
$returnhash{$name}=$value; |
$returnhash{$name}=$value; |
} |
} |
|
# initialize coursedata and userdata for this user |
# ---------------------------- initialize coursedata and userdata for this user |
|
undef %courseopt; |
undef %courseopt; |
undef %useropt; |
undef %useropt; |
|
|
my $userprefix=$uname.'_'.$udom.'_'; |
my $userprefix=$uname.'_'.$udom.'_'; |
|
|
unless ($uhome eq 'no_host') { |
unless ($uhome eq 'no_host') { |
# -------------------------------------------------------------- Get coursedata |
# Get coursedata |
unless |
unless |
((time-$courserdatas{$cid.'.last_cache'})<240) { |
((time-$courserdatas{$cid.'.last_cache'})<240) { |
my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum. |
my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum. |
':resourcedata',$chome); |
':resourcedata',$chome); |
if ($reply!~/^error\:/) { |
if ($reply!~/^error\:/) { |
$courserdatas{$cid}=$reply; |
$courserdatas{$cid}=$reply; |
$courserdatas{$cid.'.last_cache'}=time; |
$courserdatas{$cid.'.last_cache'}=time; |
} |
} |
} |
} |
foreach (split(/\&/,$courserdatas{$cid})) { |
foreach (split(/\&/,$courserdatas{$cid})) { |
my ($name,$value)=split(/\=/,$_); |
my ($name,$value)=split(/\=/,$_); |
$courseopt{$userprefix.&Apache::lonnet::unescape($name)}= |
$courseopt{$userprefix.&Apache::lonnet::unescape($name)}= |
&Apache::lonnet::unescape($value); |
&Apache::lonnet::unescape($value); |
} |
} |
# --------------------------------------------------- Get userdata (if present) |
# Get userdata (if present) |
unless |
unless |
((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) { |
((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) { |
my $reply= |
my $reply= |
&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome); |
&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome); |
if ($reply!~/^error\:/) { |
if ($reply!~/^error\:/) { |
$userrdatas{$uname.'___'.$udom}=$reply; |
$userrdatas{$uname.'___'.$udom}=$reply; |
$userrdatas{$uname.'___'.$udom.'.last_cache'}=time; |
$userrdatas{$uname.'___'.$udom.'.last_cache'}=time; |
} |
} |
} |
} |
foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) { |
foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) { |
my ($name,$value)=split(/\=/,$_); |
my ($name,$value)=split(/\=/,$_); |
$useropt{$userprefix.&Apache::lonnet::unescape($name)}= |
$useropt{$userprefix.&Apache::lonnet::unescape($name)}= |
&Apache::lonnet::unescape($value); |
&Apache::lonnet::unescape($value); |
} |
} |
} |
} |
# ----------------- now courseopt, useropt initialized for this user and course |
# now courseopt, useropt initialized for this user and course |
# (used by parmval) |
# (used by parmval) |
|
# |
# |
# Load keys for this assessment only |
# Load keys for this assessment only |
# |
# |
|
my %thisassess=(); |
my %thisassess=(); |
my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb); |
my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb); |
|
|
foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) { |
foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) { |
$thisassess{$_}=1; |
$thisassess{$_}=1; |
} |
} |
# |
# |
# Load parameters |
# Load parameters |
# |
# |
my %c=(); |
my %c=(); |
|
if (tie(%parmhash,'GDBM_File', |
if (tie(%parmhash,'GDBM_File', |
&getcfn($safeeval).'_parms.db',&GDBM_READER(),0640)) { |
&getcfn($safeeval).'_parms.db',&GDBM_READER(),0640)) { |
my %f=&getformulas($safeeval); |
my %f=&getformulas($safeeval); |
foreach (keys(%f)) { |
foreach (keys(%f)) { |
next if ($_!~/^A/); |
if ($_=~/^A/) { |
next if ($f{$_}=~/^[\!\~\-]/); |
unless ($f{$_}=~/^[\!\~\-]/) { |
if ($f{$_}=~/^parameter/) { |
if ($f{$_}=~/^parameter/) { |
if ($thisassess{$f{$_}}) { |
if ($thisassess{$f{$_}}) { |
my $val=&parmval($f{$_},$safeeval); |
my $val=&parmval($f{$_},$safeeval); |
$c{$_}=$val; |
$c{$_}=$val; |
$c{$f{$_}}=$val; |
$c{$f{$_}}=$val; |
} |
} |
} else { |
} else { |
my $key=$f{$_}; |
my $key=$f{$_}; |
my $ckey=$key; |
my $ckey=$key; |
$key=~s/^stores\_/resource\./; |
$key=~s/^stores\_/resource\./; |
$key=~s/\_/\./g; |
$key=~s/\_/\./g; |
$c{$_}=$returnhash{$key}; |
$c{$_}=$returnhash{$key}; |
$c{$ckey}=$returnhash{$key}; |
$c{$ckey}=$returnhash{$key}; |
} |
} |
|
} |
|
} |
} |
|
untie(%parmhash); |
} |
} |
untie(%parmhash); |
&setconstants($safeeval,%c); |
} |
|
&setconstants($safeeval,%c); |
|
} |
} |
|
|
# --------------------------------------------------------- Various form fields |
# --------------------------------------------------------- Various form fields |
Line 2201 sub loadassessment {
|
Line 2145 sub loadassessment {
|
sub textfield { |
sub textfield { |
my ($title,$name,$value)=@_; |
my ($title,$name,$value)=@_; |
return "\n<p><b>$title:</b><br>". |
return "\n<p><b>$title:</b><br>". |
'<input type=text name="'.$name.'" size=80 value="'.$value.'">'; |
'<input type=text name="'.$name.'" size=80 value="'.$value.'">'; |
} |
} |
|
|
sub hiddenfield { |
sub hiddenfield { |
Line 2258 sub checkthis {
|
Line 2202 sub checkthis {
|
my ($keyname,$time)=@_; |
my ($keyname,$time)=@_; |
return ($time<$expiredates{$keyname}); |
return ($time<$expiredates{$keyname}); |
} |
} |
|
|
sub forcedrecalc { |
sub forcedrecalc { |
my ($uname,$udom,$stype,$usymb)=@_; |
my ($uname,$udom,$stype,$usymb)=@_; |
my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; |
my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; |
Line 2289 sub forcedrecalc {
|
Line 2234 sub forcedrecalc {
|
# |
# |
|
|
sub exportsheet { |
sub exportsheet { |
my ($uname,$udom,$stype,$usymb,$fn)=@_; |
my ($uname,$udom,$stype,$usymb,$fn)=@_; |
my @exportarr=(); |
my @exportarr=(); |
|
if (($usymb=~/^\_(\w+)/) && (!$fn)) { |
if (($usymb=~/^\_(\w+)/) && (!$fn)) { |
$fn='default_'.$1; |
$fn='default_'.$1; |
} |
} |
# |
|
# Check if cached |
# |
# |
# Check if cached |
my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; |
# |
my $found=''; |
|
if ($oldsheets{$key}) { |
my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; |
foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) { |
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 ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); |
my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); |
if ($name eq $fn) { |
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 ($found) { |
unless ($current=~/^error\:/) { |
&cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom)); |
foreach (split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current))) { |
if ($oldsheets{$key}) { |
my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); |
foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) { |
$currentlystored{$name}=$value; |
my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); |
} |
if ($name eq $fn) { |
|
$found=$value; |
|
} |
|
} |
|
} |
} |
} |
$currentlystored{$fn}=join('___;___',@exportarr); |
# |
|
# Check if still valid |
my $newstore=''; |
# |
foreach (keys(%currentlystored)) { |
if ($found) { |
if ($newstore) { $newstore.='___&___'; } |
if (&forcedrecalc($uname,$udom,$stype,$usymb)) { |
$newstore.=$_.'___=___'.$currentlystored{$_}; |
$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; |
return @exportarr; |
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; |
|
} |
} |
|
|
# ============================================================ Expiration Dates |
# ============================================================ Expiration Dates |
# |
# |
# Load previously cached student spreadsheets for this course |
# Load previously cached student spreadsheets for this course |
# |
# |
|
|
sub expirationdates { |
sub expirationdates { |
undef %expiredates; |
undef %expiredates; |
my $cid=$ENV{'request.course.id'}; |
my $cid=$ENV{'request.course.id'}; |
Line 2490 sub cachedssheets {
|
Line 2426 sub cachedssheets {
|
|
|
sub handler { |
sub handler { |
my $r=shift; |
my $r=shift; |
|
|
if ($r->header_only) { |
if ($r->header_only) { |
$r->content_type('text/html'); |
$r->content_type('text/html'); |
$r->send_http_header; |
$r->send_http_header; |
return OK; |
return OK; |
} |
} |
|
# Global directory configs |
# ---------------------------------------------------- Global directory configs |
$includedir=$r->dir_config('lonIncludes'); |
|
$tmpdir=$r->dir_config('lonDaemons').'/tmp/'; |
$includedir=$r->dir_config('lonIncludes'); |
# Needs to be in a course |
$tmpdir=$r->dir_config('lonDaemons').'/tmp/'; |
if ($ENV{'request.course.fn'}) { |
|
# Get query string for limited number of parameters |
# ----------------------------------------------------- Needs to be in a course |
&Apache::loncommon::get_unprocessed_cgi |
|
($ENV{'QUERY_STRING'},['uname','udom','usymb','ufn']); |
if ($ENV{'request.course.fn'}) { |
if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) { |
|
$ENV{'form.ufn'}='default_'.$1; |
# --------------------------- Get query string for limited number of parameters |
} |
|
# Interactive loading of specific sheet? |
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, |
if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) { |
['uname','udom','usymb','ufn']); |
$ENV{'form.ufn'}=$ENV{'form.loadthissheet'}; |
|
} |
if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) { |
# Nothing there? Must be login user |
$ENV{'form.ufn'}='default_'.$1; |
my $aname; |
} |
my $adom; |
|
|
# -------------------------------------- Interactive loading of specific sheet? |
unless ($ENV{'form.uname'}) { |
if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) { |
$aname=$ENV{'user.name'}; |
$ENV{'form.ufn'}=$ENV{'form.loadthissheet'}; |
$adom=$ENV{'user.domain'}; |
} |
} else { |
# ------------------------------------------- Nothing there? Must be login user |
$aname=$ENV{'form.uname'}; |
|
$adom=$ENV{'form.udom'}; |
my $aname; |
} |
my $adom; |
# Open page |
|
$r->content_type('text/html'); |
unless ($ENV{'form.uname'}) { |
$r->header_out('Cache-control','no-cache'); |
$aname=$ENV{'user.name'}; |
$r->header_out('Pragma','no-cache'); |
$adom=$ENV{'user.domain'}; |
$r->send_http_header; |
} else { |
# Screen output |
$aname=$ENV{'form.uname'}; |
$r->print('<html><head><title>LON-CAPA Spreadsheet</title>'); |
$adom=$ENV{'form.udom'}; |
$r->print(<<ENDSCRIPT); |
} |
|
|
|
# ------------------------------------------------------------------- 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('<html><head><title>LON-CAPA Spreadsheet</title>'); |
|
$r->print(<<ENDSCRIPT); |
|
<script language="JavaScript"> |
<script language="JavaScript"> |
|
|
function celledit(cn,cf) { |
function celledit(cn,cf) { |
Line 2568 $tmpdir=$r->dir_config('lonDaemons').'/t
|
Line 2490 $tmpdir=$r->dir_config('lonDaemons').'/t
|
|
|
</script> |
</script> |
ENDSCRIPT |
ENDSCRIPT |
$r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet'). |
$r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet'). |
'<form action="'.$r->uri.'" name=sheet method=post>'. |
'<form action="'.$r->uri.'" name=sheet method=post>'. |
&hiddenfield('uname',$ENV{'form.uname'}). |
&hiddenfield('uname',$ENV{'form.uname'}). |
&hiddenfield('udom',$ENV{'form.udom'}). |
&hiddenfield('udom',$ENV{'form.udom'}). |
&hiddenfield('usymb',$ENV{'form.usymb'}). |
&hiddenfield('usymb',$ENV{'form.usymb'}). |
&hiddenfield('unewfield',''). |
&hiddenfield('unewfield',''). |
&hiddenfield('unewformula','')); |
&hiddenfield('unewformula','')); |
|
# Send this out right away |
# ---------------------- Make sure that this gets out, even if user hits "stop" |
$r->rflush(); |
|
# Full recalc? |
$r->rflush(); |
if ($ENV{'form.forcerecalc'}) { |
|
$r->print('<h4>Completely Recalculating Sheet ...</h4>'); |
# ---------------------------------------------------------------- Full recalc? |
undef %spreadsheets; |
|
undef %courserdatas; |
|
undef %userrdatas; |
if ($ENV{'form.forcerecalc'}) { |
undef %defaultsheets; |
$r->print('<h4>Completely Recalculating Sheet ...</h4>'); |
undef %updatedata; |
undef %spreadsheets; |
} |
undef %courserdatas; |
# Read new sheet or modified worksheet |
undef %userrdatas; |
$r->uri=~/\/(\w+)$/; |
undef %defaultsheets; |
my $asheet=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'}); |
undef %updatedata; |
# If a new formula had been entered, go from work copy |
} |
if ($ENV{'form.unewfield'}) { |
|
$r->print('<h2>Modified Workcopy</h2>'); |
# ---------------------------------------- Read new sheet or modified worksheet |
$ENV{'form.unewformula'}=~s/\'/\"/g; |
|
$r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='. |
$r->uri=~/\/(\w+)$/; |
$ENV{'form.unewformula'}.'<p>'); |
|
&setfilename($asheet,$ENV{'form.ufn'}); |
my $asheet=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'}); |
&tmpread($asheet, |
|
$ENV{'form.unewfield'},$ENV{'form.unewformula'}); |
# ------------------------ If a new formula had been entered, go from work copy |
|
|
} elsif ($ENV{'form.saveas'}) { |
if ($ENV{'form.unewfield'}) { |
&setfilename($asheet,$ENV{'form.ufn'}); |
$r->print('<h2>Modified Workcopy</h2>'); |
&tmpread($asheet); |
$ENV{'form.unewformula'}=~s/\'/\"/g; |
|
$r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='. |
|
$ENV{'form.unewformula'}.'<p>'); |
|
&setfilename($asheet,$ENV{'form.ufn'}); |
|
&tmpread($asheet, |
|
$ENV{'form.unewfield'},$ENV{'form.unewformula'}); |
|
|
|
} elsif ($ENV{'form.saveas'}) { |
|
&setfilename($asheet,$ENV{'form.ufn'}); |
|
&tmpread($asheet); |
|
} else { |
|
&readsheet($asheet,$ENV{'form.ufn'}); |
|
} |
|
|
|
# -------------------------------------------------- Print out user information |
|
|
|
unless (&gettype($asheet) eq 'classcalc') { |
|
$r->print('<p><b>User:</b> '.&getuname($asheet). |
|
'<br><b>Domain:</b> '.&getudom($asheet)); |
|
if (&getcsec($asheet) eq '-1') { |
|
$r->print('<h3><font color=red>'. |
|
'Not a student in this course</font></h3>'); |
|
} else { |
} else { |
$r->print('<br><b>Section/Group:</b> '.&getcsec($asheet)); |
&readsheet($asheet,$ENV{'form.ufn'}); |
} |
} |
if ($ENV{'form.usymb'}) { |
# Print out user information |
$r->print('<br><b>Assessment:</b> <tt>'.$ENV{'form.usymb'}.'</tt>'); |
unless (&gettype($asheet) eq 'classcalc') { |
|
$r->print('<p><b>User:</b> '.&getuname($asheet). |
|
'<br><b>Domain:</b> '.&getudom($asheet)); |
|
if (&getcsec($asheet) eq '-1') { |
|
$r->print('<h3><font color=red>'. |
|
'Not a student in this course</font></h3>'); |
|
} else { |
|
$r->print('<br><b>Section/Group:</b> '.&getcsec($asheet)); |
|
} |
|
if ($ENV{'form.usymb'}) { |
|
$r->print('<br><b>Assessment:</b> <tt>'. |
|
$ENV{'form.usymb'}.'</tt>'); |
|
} |
} |
} |
} |
# See if user can see this |
|
if ((&gettype($asheet) eq 'classcalc') || |
# ---------------------------------------------------- See if user can see this |
(&getuname($asheet) ne $ENV{'user.name'}) || |
|
(&getudom($asheet) ne $ENV{'user.domain'})) { |
if ((&gettype($asheet) eq 'classcalc') || |
unless (&Apache::lonnet::allowed('vgr',&getcid($asheet))) { |
(&getuname($asheet) ne $ENV{'user.name'}) || |
$r->print('<h1>Access Permission Denied</h1>'. |
(&getudom($asheet) ne $ENV{'user.domain'})) { |
'</form></body></html>'); |
unless (&Apache::lonnet::allowed('vgr',&getcid($asheet))) { |
return OK; |
$r->print( |
} |
'<h1>Access Permission Denied</h1></form></body></html>'); |
|
return OK; |
|
} |
} |
} |
# Additional options |
|
$r->print( |
# ---------------------------------------------------------- Additional options |
|
|
|
$r->print( |
|
'<input type=submit name=forcerecalc value="Completely Recalculate Sheet"><p>' |
'<input type=submit name=forcerecalc value="Completely Recalculate Sheet"><p>' |
); |
); |
if (&gettype($asheet) eq 'assesscalc') { |
if (&gettype($asheet) eq 'assesscalc') { |
$r->print ('<p><font size=+2><a href="/adm/studentcalc?uname='. |
$r->print ('<p><font size=+2><a href="/adm/studentcalc?uname='. |
&getuname($asheet). |
&getuname($asheet).'&udom='.&getudom($asheet).'">'. |
'&udom='.&getudom($asheet). |
'Level up: Student Sheet</a></font><p>'); |
'">Level up: Student Sheet</a></font><p>'); |
} |
} |
if ((&gettype($asheet) eq 'studentcalc') && |
|
(&Apache::lonnet::allowed('vgr',&getcid($asheet)))) { |
if ((&gettype($asheet) eq 'studentcalc') && |
$r->print ( |
(&Apache::lonnet::allowed('vgr',&getcid($asheet)))) { |
'<p><font size=+2><a href="/adm/classcalc">'. |
$r->print ( |
'Level up: Course Sheet</a></font><p>'); |
'<p><font size=+2><a href="/adm/classcalc">'. |
} |
'Level up: Course Sheet</a></font><p>'); |
# Save dialog |
} |
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { |
|
my $fname=$ENV{'form.ufn'}; |
|
$fname=~s/\_[^\_]+$//; |
# ----------------------------------------------------------------- Save dialog |
if ($fname eq 'default') { $fname='course_default'; } |
|
$r->print |
|
('<input type=submit name=saveas value="Save as ...">'. |
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { |
'<input type=text size=20 name=newfn value="'.$fname.'">'. |
my $fname=$ENV{'form.ufn'}; |
'(make default: <input type=checkbox name="makedefufn">)<p>'); |
$fname=~s/\_[^\_]+$//; |
} |
if ($fname eq 'default') { $fname='course_default'; } |
$r->print(&hiddenfield('ufn',&getfilename($asheet))); |
$r->print('<input type=submit name=saveas value="Save as ...">'. |
# Load dialog |
'<input type=text size=20 name=newfn value="'.$fname. |
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { |
'"> (make default: <input type=checkbox name="makedefufn">)<p>'); |
$r->print('<p><input type=submit name=load value="Load ...">'. |
} |
'<select name="loadthissheet">'. |
|
'<option name="default">Default</option>'); |
$r->print(&hiddenfield('ufn',&getfilename($asheet))); |
foreach (&othersheets($asheet,&gettype($asheet))) { |
|
$r->print('<option name="'.$_.'"'); |
# ----------------------------------------------------------------- Load dialog |
if ($ENV{'form.ufn'} eq $_) { |
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { |
$r->print(' selected'); |
$r->print('<p><input type=submit name=load value="Load ...">'. |
} |
'<select name="loadthissheet">'. |
$r->print('>'.$_.'</option>'); |
'<option name="default">Default</option>'); |
} |
foreach (&othersheets($asheet,&gettype($asheet))) { |
$r->print('</select><p>'); |
$r->print('<option name="'.$_.'"'); |
if (&gettype($asheet) eq 'studentcalc') { |
if ($ENV{'form.ufn'} eq $_) { |
&setothersheets($asheet,&othersheets($asheet,'assesscalc')); |
$r->print(' selected'); |
|
} |
} |
$r->print('>'.$_.'</option>'); |
|
} |
|
$r->print('</select><p>'); |
|
if (&gettype($asheet) eq 'studentcalc') { |
|
&setothersheets($asheet,&othersheets($asheet,'assesscalc')); |
|
} |
} |
} |
# Cached sheets |
|
&expirationdates(); |
# --------------------------------------------------------------- Cached sheets |
undef %oldsheets; |
|
undef %loadedcaches; |
&expirationdates(); |
if (&gettype($asheet) eq 'classcalc') { |
|
$r->print |
undef %oldsheets; |
("Loading previously calculated student sheets ...<br>\n"); |
undef %loadedcaches; |
$r->rflush(); |
|
&cachedcsheets(); |
if (&gettype($asheet) eq 'classcalc') { |
} elsif (&gettype($asheet) eq 'studentcalc') { |
$r->print("Loading previously calculated student sheets ...<br>\n"); |
$r->print |
|
("Loading previously calculated assessment sheets ...<br>\n"); |
|
$r->rflush(); |
|
&cachedssheets(&getuname($asheet),&getudom($asheet), |
|
&getuhome($asheet)); |
|
} |
|
# Update sheet, load rows |
|
$r->print("Loaded sheet(s), updating rows ...<br>\n"); |
$r->rflush(); |
$r->rflush(); |
&cachedcsheets(); |
# |
} elsif (&gettype($asheet) eq 'studentcalc') { |
&updatesheet($asheet); |
$r->print("Loading previously calculated assessment sheets ...<br>\n"); |
$r->print("Updated rows, loading row data ...<br>\n"); |
$r->rflush(); |
$r->rflush(); |
&cachedssheets(&getuname($asheet),&getudom($asheet), |
# |
&getuhome($asheet)); |
&loadrows($asheet,$r); |
} |
$r->print("Loaded row data, calculating sheet ...<br>\n"); |
|
$r->rflush(); |
# ----------------------------------------------------- Update sheet, load rows |
# |
|
my $calcoutput=&calcsheet($asheet); |
$r->print("Loaded sheet(s), updating rows ...<br>\n"); |
$r->print('<h3><font color=red>'.$calcoutput.'</h3></font>'); |
$r->rflush(); |
# See if something to save |
|
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { |
&updatesheet($asheet); |
my $fname=''; |
|
if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) { |
$r->print("Updated rows, loading row data ...<br>\n"); |
$fname=~s/\W/\_/g; |
$r->rflush(); |
if ($fname eq 'default') { $fname='course_default'; } |
|
$fname.='_'.&gettype($asheet); |
&loadrows($asheet,$r); |
&setfilename($asheet,$fname); |
|
$ENV{'form.ufn'}=$fname; |
$r->print("Loaded row data, calculating sheet ...<br>\n"); |
$r->print('<p>Saving spreadsheet: '. |
$r->rflush(); |
&writesheet($asheet,$ENV{'form.makedefufn'}).'<p>'); |
|
} |
my $calcoutput=&calcsheet($asheet); |
} |
$r->print('<h3><font color=red>'.$calcoutput.'</h3></font>'); |
#Write the modified worksheet |
|
|
# ---------------------------------------------------- See if something to save |
|
|
|
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { |
|
my $fname=''; |
|
if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) { |
|
$fname=~s/\W/\_/g; |
|
if ($fname eq 'default') { $fname='course_default'; } |
|
$fname.='_'.&gettype($asheet); |
|
&setfilename($asheet,$fname); |
|
$ENV{'form.ufn'}=$fname; |
|
$r->print('<p>Saving spreadsheet: '. |
|
&writesheet($asheet,$ENV{'form.makedefufn'}).'<p>'); |
|
} |
|
} |
|
|
|
# ------------------------------------------------ Write the modified worksheet |
|
|
|
$r->print('<b>Current sheet:</b> '.&getfilename($asheet).'<p>'); |
$r->print('<b>Current sheet:</b> '.&getfilename($asheet).'<p>'); |
|
|