# The LearningOnline Network with CAPA
# Spreadsheet/Grades Display Handler
#
# 11/11,11/15,11/27,12/04,12/05,12/06,12/07,
# 12/08,12/09,12/11,12/12,12/15,12/16,12/18,12/19,12/30,
# 01/01/01,02/01,03/01,19/01,20/01,22/01,
# 03/05,03/08,03/10,03/12,03/13,03/15,03/17,
# 03/19,03/20,03/21,03/27,04/05,04/09,
# 07/09,07/14,07/21,09/01,09/10,9/11,9/12,9/13,9/14,9/17 Gerd Kortemeyer
package Apache::lonspreadsheet;
use strict;
use Safe;
use Safe::Hole;
use Opcode;
use Apache::lonnet;
use Apache::Constants qw(:common :http);
use GDBM_File;
use HTML::TokeParser;
#
# Caches for previously calculated spreadsheets
#
my %oldsheets;
my %loadedcaches;
my %expiredates;
#
# Cache for stores of an individual user
#
my $cachedassess;
my %cachedstores;
#
# These cache hashes need to be independent of user, resource and course
# (user and course can/should be in the keys)
#
my %spreadsheets;
my %courserdatas;
my %userrdatas;
my %defaultsheets;
my %updatedata;
#
# These global hashes are dependent on user, course and resource,
# and need to be initialized every time when a sheet is calculated
#
my %courseopt;
my %useropt;
my %parmhash;
# Stuff that only the screen handler can know
my $includedir;
my $tmpdir;
# =============================================================================
# ===================================== Implements an instance of a spreadsheet
sub initsheet {
my $safeeval = new Safe(shift);
my $safehole = new Safe::Hole;
$safeeval->permit("entereval");
$safeeval->permit(":base_math");
$safeeval->permit("sort");
$safeeval->deny(":base_io");
$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
my $code=<<'ENDDEFS';
# ---------------------------------------------------- Inside of the safe space
#
# f: formulas
# t: intermediate format (variable references expanded)
# v: output values
# c: preloaded constants (A-column)
# rl: row label
# os: other spreadsheets (for student spreadsheet only)
undef %v;
undef %t;
undef %f;
undef %c;
undef %rl;
undef @os;
$maxrow=0;
$sheettype='';
# filename/reference of the sheet
$filename='';
# user data
$uname='';
$uhome='';
$udom='';
# course data
$csec='';
$chome='';
$cnum='';
$cdom='';
$cid='';
$cfn='';
# symb
$usymb='';
sub mask {
my ($lower,$upper)=@_;
$lower=~/([A-Za-z]|\*)(\d+|\*)/;
my $la=$1;
my $ld=$2;
$upper=~/([A-Za-z]|\*)(\d+|\*)/;
my $ua=$1;
my $ud=$2;
my $alpha='';
my $num='';
if (($la eq '*') || ($ua eq '*')) {
$alpha='[A-Za-z]';
} else {
if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||
($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
$alpha='['.$la.'-'.$ua.']';
} else {
$alpha='['.$la.'-Za-'.$ua.']';
}
}
if (($ld eq '*') || ($ud eq '*')) {
$num='\d+';
} else {
if (length($ld)!=length($ud)) {
$num.='(';
map {
$num.='['.$_.'-9]';
} ($ld=~m/\d/g);
if (length($ud)-length($ld)>1) {
$num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
}
$num.='|';
map {
$num.='[0-'.$_.']';
} ($ud=~m/\d/g);
$num.=')';
} else {
my @lda=($ld=~m/\d/g);
my @uda=($ud=~m/\d/g);
my $i; $j=0; $notdone=1;
for ($i=0;($i<=$#lda)&&($notdone);$i++) {
if ($lda[$i]==$uda[$i]) {
$num.=$lda[$i];
$j=$i;
} else {
$notdone=0;
}
}
if ($j<$#lda-1) {
$num.='('.$lda[$j+1];
for ($i=$j+2;$i<=$#lda;$i++) {
$num.='['.$lda[$i].'-9]';
}
if ($uda[$j+1]-$lda[$j+1]>1) {
$num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
($#lda-$j-1).'}';
}
$num.='|'.$uda[$j+1];
for ($i=$j+2;$i<=$#uda;$i++) {
$num.='[0-'.$uda[$i].']';
}
$num.=')';
} else {
if ($lda[$#lda]!=$uda[$#uda]) {
$num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
}
}
}
}
return '^'.$alpha.$num."\$";
}
sub NUM {
my $mask=mask(@_);
my $num=0;
map {
$num++;
} grep /$mask/,keys %v;
return $num;
}
sub BIN {
my ($low,$high,$lower,$upper)=@_;
my $mask=mask($lower,$upper);
my $num=0;
map {
if (($v{$_}>=$low) && ($v{$_}<=$high)) {
$num++;
}
} grep /$mask/,keys %v;
return $num;
}
sub SUM {
my $mask=mask(@_);
my $sum=0;
map {
$sum+=$v{$_};
} grep /$mask/,keys %v;
return $sum;
}
sub MEAN {
my $mask=mask(@_);
my $sum=0; my $num=0;
map {
$sum+=$v{$_};
$num++;
} grep /$mask/,keys %v;
if ($num) {
return $sum/$num;
} else {
return undef;
}
}
sub STDDEV {
my $mask=mask(@_);
my $sum=0; my $num=0;
map {
$sum+=$v{$_};
$num++;
} grep /$mask/,keys %v;
unless ($num>1) { return undef; }
my $mean=$sum/$num;
$sum=0;
map {
$sum+=($v{$_}-$mean)**2;
} grep /$mask/,keys %v;
return sqrt($sum/($num-1));
}
sub PROD {
my $mask=mask(@_);
my $prod=1;
map {
$prod*=$v{$_};
} grep /$mask/,keys %v;
return $prod;
}
sub MAX {
my $mask=mask(@_);
my $max='-';
map {
unless ($max) { $max=$v{$_}; }
if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
} grep /$mask/,keys %v;
return $max;
}
sub MIN {
my $mask=mask(@_);
my $min='-';
map {
unless ($max) { $max=$v{$_}; }
if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
} grep /$mask/,keys %v;
return $min;
}
sub SUMMAX {
my ($num,$lower,$upper)=@_;
my $mask=mask($lower,$upper);
my @inside=();
map {
$inside[$#inside+1]=$v{$_};
} grep /$mask/,keys %v;
@inside=sort(@inside);
my $sum=0; my $i;
for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
$sum+=$inside[$i];
}
return $sum;
}
sub SUMMIN {
my ($num,$lower,$upper)=@_;
my $mask=mask($lower,$upper);
my @inside=();
map {
$inside[$#inside+1]=$v{$_};
} grep /$mask/,keys %v;
@inside=sort(@inside);
my $sum=0; my $i;
for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
$sum+=$inside[$i];
}
return $sum;
}
sub expandnamed {
my $expression=shift;
if ($expression=~/^\&/) {
my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/);
my @vars=split(/\W+/,$formula);
my %values=();
undef %values;
map {
my $varname=$_;
if ($varname=~/\D/) {
$formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
$varname=~s/$var/\(\\w\+\)/g;
map {
if ($_=~/$varname/) {
$values{$1}=1;
}
} keys %c;
}
} @vars;
if ($func eq 'EXPANDSUM') {
my $result='';
map {
my $thissum=$formula;
$thissum=~s/$var/$_/g;
$result.=$thissum.'+';
} keys %values;
$result=~s/\+$//;
return $result;
} else {
return 0;
}
} else {
return '$c{\''.$expression.'\'}';
}
}
sub sett {
%t=();
my $pattern='';
if ($sheettype eq 'assesscalc') {
$pattern='A';
} else {
$pattern='[A-Z]';
}
map {
if ($_=~/template\_(\w)/) {
my $col=$1;
unless ($col=~/^$pattern/) {
map {
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;
}
}
} keys %f;
}
}
} keys %f;
map {
if (($f{$_}) && ($_!~/template\_/)) {
my $matches=($_=~/^$pattern(\d+)/);
if (($matches) && ($1)) {
unless ($f{$_}=~/^\!/) {
$t{$_}=$c{$_};
}
} else {
$t{$_}=$f{$_};
$t{$_}=~s/\.\.+/\,/g;
$t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
$t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
}
}
} keys %f;
$t{'A0'}=$f{'A0'};
$t{'A0'}=~s/\.\.+/\,/g;
$t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
$t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
}
sub calc {
%v=();
&sett();
my $notfinished=1;
my $depth=0;
while ($notfinished) {
$notfinished=0;
map {
my $old=$v{$_};
$v{$_}=eval($t{$_});
if ($@) {
%v=();
return $@;
}
if ($v{$_} ne $old) { $notfinished=1; }
} keys %t;
$depth++;
if ($depth>100) {
%v=();
return 'Maximum calculation depth exceeded';
}
}
return '';
}
sub templaterow {
my @cols=();
$cols[0]='<b><font size=+1>Template</font></b>';
map {
my $fm=$f{'template_'.$_};
$fm=~s/[\'\"]/\&\#34;/g;
$cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm;
} ('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');
return @cols;
}
sub outrowassess {
my $n=shift;
my @cols=();
if ($n) {
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});
$cols[0]=$rl{$usy}.'<br>'.
'<select name="sel_'.$n.'" onChange="changesheet('.$n.
')"><option name="default">Default</option>';
map {
$cols[0].='<option name="'.$_.'"';
if ($ufn eq $_) {
$cols[0].=' selected';
}
$cols[0].='>'.$_.'</option>';
} @os;
$cols[0].='</select>';
} else {
$cols[0]='<b><font size=+1>Export</font></b>';
}
map {
my $fm=$f{$_.$n};
$fm=~s/[\'\"]/\&\#34;/g;
$cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
} ('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');
return @cols;
}
sub outrow {
my $n=shift;
my @cols=();
if ($n) {
$cols[0]=$rl{$f{'A'.$n}};
} else {
$cols[0]='<b><font size=+1>Export</font></b>';
}
map {
my $fm=$f{$_.$n};
$fm=~s/[\'\"]/\&\#34;/g;
$cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
} ('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');
return @cols;
}
sub exportrowa {
my @exportarray=();
map {
$exportarray[$#exportarray+1]=$v{$_.'0'};
} ('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');
return @exportarray;
}
# ------------------------------------------- End of "Inside of the safe space"
ENDDEFS
$safeeval->reval($code);
return $safeeval;
}
# ------------------------------------------------ Add or change formula values
sub setformulas {
my ($safeeval,%f)=@_;
%{$safeeval->varglob('f')}=%f;
}
# ------------------------------------------------ Add or change formula values
sub setconstants {
my ($safeeval,%c)=@_;
%{$safeeval->varglob('c')}=%c;
}
# --------------------------------------------- Set names of other spreadsheets
sub setothersheets {
my ($safeeval,@os)=@_;
@{$safeeval->varglob('os')}=@os;
}
# ------------------------------------------------ Add or change formula values
sub setrowlabels {
my ($safeeval,%rl)=@_;
%{$safeeval->varglob('rl')}=%rl;
}
# ------------------------------------------------------- Calculate spreadsheet
sub calcsheet {
my $safeeval=shift;
$safeeval->reval('&calc();');
}
# ------------------------------------------------------------------ Get values
sub getvalues {
my $safeeval=shift;
return $safeeval->reval('%v');
}
# ---------------------------------------------------------------- Get formulas
sub getformulas {
my $safeeval=shift;
return %{$safeeval->varglob('f')};
}
# -------------------------------------------------------------------- Get type
sub gettype {
my $safeeval=shift;
return $safeeval->reval('$sheettype');
}
# ------------------------------------------------------------------ Set maxrow
sub setmaxrow {
my ($safeeval,$row)=@_;
$safeeval->reval('$maxrow='.$row.';');
}
# ------------------------------------------------------------------ Get maxrow
sub getmaxrow {
my $safeeval=shift;
return $safeeval->reval('$maxrow');
}
# ---------------------------------------------------------------- Set filename
sub setfilename {
my ($safeeval,$fn)=@_;
$safeeval->reval('$filename="'.$fn.'";');
}
# ---------------------------------------------------------------- Get filename
sub getfilename {
my $safeeval=shift;
return $safeeval->reval('$filename');
}
# --------------------------------------------------------------- Get course ID
sub getcid {
my $safeeval=shift;
return $safeeval->reval('$cid');
}
# --------------------------------------------------------- Get course filename
sub getcfn {
my $safeeval=shift;
return $safeeval->reval('$cfn');
}
# ----------------------------------------------------------- Get course number
sub getcnum {
my $safeeval=shift;
return $safeeval->reval('$cnum');
}
# ------------------------------------------------------------- Get course home
sub getchome {
my $safeeval=shift;
return $safeeval->reval('$chome');
}
# ----------------------------------------------------------- Get course domain
sub getcdom {
my $safeeval=shift;
return $safeeval->reval('$cdom');
}
# ---------------------------------------------------------- Get course section
sub getcsec {
my $safeeval=shift;
return $safeeval->reval('$csec');
}
# --------------------------------------------------------------- Get user name
sub getuname {
my $safeeval=shift;
return $safeeval->reval('$uname');
}
# ------------------------------------------------------------- Get user domain
sub getudom {
my $safeeval=shift;
return $safeeval->reval('$udom');
}
# --------------------------------------------------------------- Get user home
sub getuhome {
my $safeeval=shift;
return $safeeval->reval('$uhome');
}
# -------------------------------------------------------------------- Get symb
sub getusymb {
my $safeeval=shift;
return $safeeval->reval('$usymb');
}
# ------------------------------------------------------------- Export of A-row
sub exportdata {
my $safeeval=shift;
return $safeeval->reval('&exportrowa()');
}
# ========================================================== End of Spreadsheet
# =============================================================================
#
# Procedures for screen output
#
# --------------------------------------------- Produce output row n from sheet
sub rown {
my ($safeeval,$n)=@_;
my $defaultbg;
my $rowdata='';
my $dataflag=0;
unless ($n eq '-') {
$defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
} else {
$defaultbg='#E0FF';
}
$rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>";
my $showf=0;
my $proc;
my $maxred;
my $sheettype=&gettype($safeeval);
if ($sheettype eq 'studentcalc') {
$proc='&outrowassess';
$maxred=26;
} else {
$proc='&outrow';
}
if ($sheettype eq 'assesscalc') {
$maxred=1;
} else {
$maxred=26;
}
if ($n eq '-') { $proc='&templaterow'; $n=-1; $dataflag=1; }
map {
my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
if ((($vl ne '') || ($vl eq '0')) &&
(($showf==1) || ($sheettype ne 'studentcalc'))) { $dataflag=1; }
if ($showf==0) { $vl=$_; }
if ($showf<=$maxred) { $bgcolor='#FFDDDD'; }
if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }
if (($showf>$maxred) || ((!$n) && ($showf>0))) {
if ($vl eq '') {
$vl='<font size=+2 color='.$bgcolor.'>#</font>';
}
$rowdata.=
'<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.
'</a></td>';
} else {
$rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';
}
$showf++;
} $safeeval->reval($proc.'('.$n.')');
if ($ENV{'form.showall'} || ($dataflag)) {
return $rowdata.'</tr>';
} else {
return '';
}
}
# ------------------------------------------------------------- Print out sheet
sub outsheet {
my ($r,$safeeval)=@_;
my $maxred;
my $realm;
if (&gettype($safeeval) eq 'assesscalc') {
$maxred=1;
$realm='Assessment';
} elsif (&gettype($safeeval) eq 'studentcalc') {
$maxred=26;
$realm='User';
} else {
$maxred=26;
$realm='Course';
}
my $maxyellow=52-$maxred;
my $tabledata=
'<table border=2><tr><th colspan=2 rowspan=2><font size=+2>'.
$realm.'</font></th>'.
'<td bgcolor=#FFDDDD colspan='.$maxred.
'><b><font size=+1>Import</font></b></td>'.
'<td colspan='.$maxyellow.
'><b><font size=+1>Calculations</font></b></td></tr><tr>';
my $showf=0;
map {
$showf++;
if ($showf<=$maxred) {
$tabledata.='<td bgcolor="#FFDDDD">';
} else {
$tabledata.='<td>';
}
$tabledata.="<b><font size=+1>$_</font></b></td>";
} ('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');
$tabledata.='</tr>';
my $row;
my $maxrow=&getmaxrow($safeeval);
$tabledata.=&rown($safeeval,'-').&rown($safeeval,0);
$r->print($tabledata);
my @sortby=();
my @sortidx=();
for ($row=1;$row<=$maxrow;$row++) {
$sortby[$row-1]=$safeeval->reval('$f{"A'.$row.'"}');
$sortidx[$row-1]=$row-1;
}
@sortidx=sort { $sortby[$a] cmp $sortby[$b]; } @sortidx;
my $what='Student';
if (&gettype($safeeval) eq 'assesscalc') {
$what='Item';
} elsif (&gettype($safeeval) eq 'studentcalc') {
$what='Assessment';
}
my $n=0;
for ($row=0;$row<$maxrow;$row++) {
my $thisrow=&rown($safeeval,$sortidx[$row]+1);
if ($thisrow) {
if ($n/25==int($n/25)) {
$r->print("</table>\n<br>\n");
$r->rflush();
$r->print('<table border=2><tr><td> <td>'.$what.'</td>');
map {
$r->print('<td>'.$_.'</td>');
} ('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('</tr>');
}
$n++;
$r->print($thisrow);
}
}
$r->print('</table>');
}
#
# ----------------------------------------------- Read list of available sheets
#
sub othersheets {
my ($safeeval,$stype)=@_;
my $cnum=&getcnum($safeeval);
my $cdom=&getcdom($safeeval);
my $chome=&getchome($safeeval);
my @alternatives=();
my $result=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.
$stype.'_spreadsheets',$chome);
if ($result!~/^error\:/) {
map {
$alternatives[$#alternatives+1]=
&Apache::lonnet::unescape((split(/\=/,$_))[0]);
} split(/\&/,$result);
}
return @alternatives;
}
#
# -------------------------------------- Read spreadsheet formulas for a course
#
sub readsheet {
my ($safeeval,$fn)=@_;
my $stype=&gettype($safeeval);
my $cnum=&getcnum($safeeval);
my $cdom=&getcdom($safeeval);
my $chome=&getchome($safeeval);
# --------- There is no filename. Look for defaults in course and global, cache
unless($fn) {
unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
$fn=&Apache::lonnet::reply('get:'.$cdom.':'.$cnum.
':environment:spreadsheet_default_'.$stype,
$chome);
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;
if ($fh=Apache::File->new($includedir.
'/default.'.&gettype($safeeval))) {
$sheetxml=join('',<$fh>);
}
}
my $parser=HTML::TokeParser->new(\$sheetxml);
my $token;
while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {
if ($token->[1] eq 'field') {
$f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
$parser->get_text('/field');
}
if ($token->[1] eq 'template') {
$f{'template_'.$token->[2]->{'col'}}=
$parser->get_text('/template');
}
}
}
} else {
my $sheet='';
my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.$fn,
$chome);
unless ($reply=~/^error\:/) {
$sheet=$reply;
}
map {
my ($name,$value)=split(/\=/,$_);
$f{&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
} split(/\&/,$sheet);
}
# --------------------------------------------------------------- Cache and set
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
&setformulas($safeeval,%f);
}
}
# -------------------------------------------------------- Make new spreadsheet
sub makenewsheet {
my ($uname,$udom,$stype,$usymb)=@_;
my $safeeval=initsheet($stype);
$safeeval->reval(
'$uname="'.$uname.
'";$udom="'.$udom.
'";$uhome="'.&Apache::lonnet::homeserver($uname,$udom).
'";$sheettype="'.$stype.
'";$usymb="'.$usymb.
'";$csec="'.&Apache::lonnet::usection($udom,$uname,
$ENV{'request.course.id'}).
'";$cid="'.$ENV{'request.course.id'}.
'";$cfn="'.$ENV{'request.course.fn'}.
'";$cnum="'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
'";$cdom="'.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
'";$chome="'.$ENV{'course.'.$ENV{'request.course.id'}.'.home'}.'";');
return $safeeval;
}
# ------------------------------------------------------------ Save spreadsheet
sub writesheet {
my ($safeeval,$makedef)=@_;
my $cid=&getcid($safeeval);
if (&Apache::lonnet::allowed('opa',$cid)) {
my %f=&getformulas($safeeval);
my $stype=&gettype($safeeval);
my $cnum=&getcnum($safeeval);
my $cdom=&getcdom($safeeval);
my $chome=&getchome($safeeval);
my $fn=&getfilename($safeeval);
# ------------------------------------------------------------- Cache new sheet
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
# ----------------------------------------------------------------- Write sheet
my $sheetdata='';
map {
unless ($f{$_} eq 'import') {
$sheetdata.=&Apache::lonnet::escape($_).'='.
&Apache::lonnet::escape($f{$_}).'&';
}
} keys %f;
$sheetdata=~s/\&$//;
my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'.
$sheetdata,$chome);
if ($reply eq 'ok') {
$reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.
$stype.'_spreadsheets:'.
&Apache::lonnet::escape($fn).'='.$ENV{'user.name'}.'@'.
$ENV{'user.domain'},
$chome);
if ($reply eq 'ok') {
if ($makedef) {
return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum.
':environment:spreadsheet_default_'.$stype.'='.
&Apache::lonnet::escape($fn),
$chome);
} else {
return $reply;
}
} else {
return $reply;
}
} else {
return $reply;
}
}
return 'unauthorized';
}
# ----------------------------------------------- Make a temp copy of the sheet
# "Modified workcopy" - interactive only
#
sub tmpwrite {
my $safeeval=shift;
my $fn=$ENV{'user.name'}.'_'.
$ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'.
&getfilename($safeeval);
$fn=~s/\W/\_/g;
$fn=$tmpdir.$fn.'.tmp';
my $fh;
if ($fh=Apache::File->new('>'.$fn)) {
print $fh join("\n",&getformulas($safeeval));
}
}
# ---------------------------------------------------------- Read the temp copy
sub tmpread {
my ($safeeval,$nfield,$nform)=@_;
my $fn=$ENV{'user.name'}.'_'.
$ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'.
&getfilename($safeeval);
$fn=~s/\W/\_/g;
$fn=$tmpdir.$fn.'.tmp';
my $fh;
my %fo=();
if ($fh=Apache::File->new($fn)) {
my $name;
while ($name=<$fh>) {
chomp($name);
my $value=<$fh>;
chomp($value);
$fo{$name}=$value;
}
}
if ($nform eq 'changesheet') {
$fo{'A'.$nfield}=(split(/\_\_\&\&\&\_\_/,$fo{'A'.$nfield}))[0];
unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
$fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
}
} else {
if ($nfield) { $fo{$nfield}=$nform; }
}
&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 {
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/\_/\./;
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}; }
if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }
if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
# ----------------------------------------------------- second, check map parms
my $thisparm=$parmhash{$symbparm};
if ($thisparm) { return $thisparm; }
# -------------------------------------------------------- first, check default
return &Apache::lonnet::metadata($fn,$rwhat.'.default');
}
# ---------------------------------------------- Update rows for course listing
sub updateclasssheet {
my $safeeval=shift;
my $cnum=&getcnum($safeeval);
my $cdom=&getcdom($safeeval);
my $cid=&getcid($safeeval);
my $chome=&getchome($safeeval);
# ---------------------------------------------- Read class list and row labels
my $classlst=&Apache::lonnet::reply
('dump:'.$cdom.':'.$cnum.':classlist',$chome);
my %currentlist=();
my $now=time;
unless ($classlst=~/^error\:/) {
map {
my ($name,$value)=split(/\=/,$_);
my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));
my $active=1;
if (($end) && ($now>$end)) { $active=0; }
if ($active) {
my $rowlabel='';
$name=&Apache::lonnet::unescape($name);
my ($sname,$sdom)=split(/\:/,$name);
my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);
if ($ssec==-1) {
$rowlabel='<font color=red>Data not available: '.$name.
'</font>';
} else {
my %reply=&Apache::lonnet::idrget($sdom,$sname);
my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.
':environment:firstname&middlename&lastname&generation',
&Apache::lonnet::homeserver($sname,$sdom));
$rowlabel='<a href="/adm/studentcalc?uname='.$sname.
'&udom='.$sdom.'">'.
$ssec.' '.$reply{$sname}.'<br>';
map {
$rowlabel.=&Apache::lonnet::unescape($_).' ';
} split(/\&/,$reply);
$rowlabel.='</a>';
}
$currentlist{&Apache::lonnet::unescape($name)}=$rowlabel;
}
} split(/\&/,$classlst);
#
# -------------------- Find discrepancies between the course row table and this
#
my %f=&getformulas($safeeval);
my $changed=0;
my $maxrow=0;
my %existing=();
# ----------------------------------------------------------- Now obsolete rows
map {
if ($_=~/^A(\d+)/) {
$maxrow=($1>$maxrow)?$1:$maxrow;
$existing{$f{$_}}=1;
unless ((defined($currentlist{$f{$_}})) || (!$1)) {
$f{$_}='!!! Obsolete';
$changed=1;
}
}
} keys %f;
# -------------------------------------------------------- New and unknown keys
map {
unless ($existing{$_}) {
$changed=1;
$maxrow++;
$f{'A'.$maxrow}=$_;
}
} sort keys %currentlist;
if ($changed) { &setformulas($safeeval,%f); }
&setmaxrow($safeeval,$maxrow);
&setrowlabels($safeeval,%currentlist);
} else {
return 'Could not access course data';
}
}
# ----------------------------------- Update rows for student and assess sheets
sub updatestudentassesssheet {
my $safeeval=shift;
my %bighash;
my $stype=&gettype($safeeval);
my %current=();
unless ($updatedata{$ENV{'request.course.fn'}.'_'.$stype}) {
# -------------------------------------------------------------------- Tie hash
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
&GDBM_READER,0640)) {
# --------------------------------------------------------- Get all assessments
my %allkeys=('timestamp' =>
'Timestamp of Last Transaction<br>timestamp');
my %allassess=();
my $adduserstr='';
if ((&getuname($safeeval) ne $ENV{'user.name'}) ||
(&getudom($safeeval) ne $ENV{'user.domain'})) {
$adduserstr='&uname='.&getuname($safeeval).
'&udom='.&getudom($safeeval);
}
map {
if ($_=~/^src\_(\d+)\.(\d+)$/) {
my $mapid=$1;
my $resid=$2;
my $id=$mapid.'.'.$resid;
my $srcf=$bighash{$_};
if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
my $symb=
&Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
'___'.$resid.'___'.
&Apache::lonnet::declutter($srcf);
$allassess{$symb}=
'<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'.
$bighash{'title_'.$id}.'</a>';
if ($stype eq 'assesscalc') {
map {
if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {
my $key=$_;
my $display=
&Apache::lonnet::metadata($srcf,$key.'.display');
unless ($display) {
$display.=
&Apache::lonnet::metadata($srcf,$key.'.name');
}
$display.='<br>'.$key;
$allkeys{$key}=$display;
}
} split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
}
}
}
} keys %bighash;
untie(%bighash);
#
# %allkeys has a list of storage and parameter displays by unikey
# %allassess has a list of all resource displays by symb
#
if ($stype eq 'assesscalc') {
%current=%allkeys;
} elsif ($stype eq 'studentcalc') {
%current=%allassess;
}
$updatedata{$ENV{'request.course.fn'}.'_'.$stype}=
join('___;___',%current);
} else {
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
#
my %f=&getformulas($safeeval);
my $changed=0;
my $maxrow=0;
my %existing=();
# ----------------------------------------------------------- Now obsolete rows
map {
if ($_=~/^A(\d+)/) {
$maxrow=($1>$maxrow)?$1:$maxrow;
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
$existing{$usy}=1;
unless ((defined($current{$usy})) || (!$1)) {
$f{$_}='!!! Obsolete';
$changed=1;
} elsif ($ufn) {
$current{$usy}
=~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/;
}
}
} keys %f;
# -------------------------------------------------------- New and unknown keys
map {
unless ($existing{$_}) {
$changed=1;
$maxrow++;
$f{'A'.$maxrow}=$_;
}
} keys %current;
if ($changed) { &setformulas($safeeval,%f); }
&setmaxrow($safeeval,$maxrow);
&setrowlabels($safeeval,%current);
undef %current;
undef %existing;
}
# ------------------------------------------------ Load data for one assessment
sub loadstudent {
my $safeeval=shift;
my %c=();
my %f=&getformulas($safeeval);
$cachedassess=&getuname($safeeval).':'.&getudom($safeeval);
%cachedstores=();
{
my $reply=&Apache::lonnet::reply('dump:'.&getudom($safeeval).':'.
&getuname($safeeval).':'.
&getcid($safeeval),
&getuhome($safeeval));
unless ($reply=~/^error\:/) {
map {
my ($name,$value)=split(/\=/,$_);
$cachedstores{&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
} split(/\&/,$reply);
}
}
my @assessdata=();
map {
if ($_=~/^A(\d+)/) {
my $row=$1;
unless (($f{$_}=~/^\!/) || ($row==0)) {
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
@assessdata=&exportsheet(&getuname($safeeval),
&getudom($safeeval),
'assesscalc',$usy,$ufn);
my $index=0;
map {
if ($assessdata[$index]) {
my $col=$_;
if ($assessdata[$index]=~/\D/) {
$c{$col.$row}="'".$assessdata[$index]."'";
} else {
$c{$col.$row}=$assessdata[$index];
}
unless ($col eq 'A') {
$f{$col.$row}='import';
}
}
$index++;
} ('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');
}
}
} keys %f;
$cachedassess='';
undef %cachedstores;
&setformulas($safeeval,%f);
&setconstants($safeeval,%c);
}
# --------------------------------------------------- Load data for one student
sub loadcourse {
my ($safeeval,$r)=@_;
my %c=();
my %f=&getformulas($safeeval);
my $total=0;
map {
if ($_=~/^A(\d+)/) {
unless ($f{$_}=~/^\!/) { $total++; }
}
} keys %f;
my $now=0;
my $since=time;
$r->print(<<ENDPOP);
<script>
popwin=open('','popwin','width=400,height=100');
popwin.document.writeln('<html><body bgcolor="#FFFFFF">'+
'<h3>Spreadsheet Calculation Progress</h3>'+
'<form name=popremain>'+
'<input type=text size=35 name=remaining value=Starting></form>'+
'</body></html>');
popwin.document.close();
</script>
ENDPOP
$r->rflush();
map {
if ($_=~/^A(\d+)/) {
my $row=$1;
unless (($f{$_}=~/^\!/) || ($row==0)) {
my @studentdata=&exportsheet(split(/\:/,$f{$_}),
'studentcalc');
undef %userrdatas;
$now++;
$r->print('<script>popwin.document.popremain.remaining.value="'.
$now.'/'.$total.': '.int((time-$since)/$now*($total-$now)).
' secs remaining";</script>');
$r->rflush();
my $index=0;
map {
if ($studentdata[$index]) {
my $col=$_;
if ($studentdata[$index]=~/\D/) {
$c{$col.$row}="'".$studentdata[$index]."'";
} else {
$c{$col.$row}=$studentdata[$index];
}
unless ($col eq 'A') {
$f{$col.$row}='import';
}
}
$index++;
} ('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');
}
}
} keys %f;
&setformulas($safeeval,%f);
&setconstants($safeeval,%c);
$r->print('<script>popwin.close()</script>');
$r->rflush();
}
# ------------------------------------------------ Load data for one assessment
sub loadassessment {
my $safeeval=shift;
my $uhome=&getuhome($safeeval);
my $uname=&getuname($safeeval);
my $udom=&getudom($safeeval);
my $symb=&getusymb($safeeval);
my $cid=&getcid($safeeval);
my $cnum=&getcnum($safeeval);
my $cdom=&getcdom($safeeval);
my $chome=&getchome($safeeval);
my $namespace;
unless ($namespace=$cid) { return ''; }
# ----------------------------------------------------------- Get stored values
my %returnhash=();
if ($cachedassess eq $uname.':'.$udom) {
#
# get data out of the dumped stores
#
my $version=$cachedstores{'version:'.$symb};
my $scope;
for ($scope=1;$scope<=$version;$scope++) {
map {
$returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};
} split(/\:/,$cachedstores{$scope.':keys:'.$symb});
}
} else {
#
# restore individual
#
my $answer=&Apache::lonnet::reply(
"restore:$udom:$uname:".
&Apache::lonnet::escape($namespace).":".
&Apache::lonnet::escape($symb),$uhome);
map {
my ($name,$value)=split(/\=/,$_);
$returnhash{&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
} split(/\&/,$answer);
my $version;
for ($version=1;$version<=$returnhash{'version'};$version++) {
map {
$returnhash{$_}=$returnhash{$version.':'.$_};
} split(/\:/,$returnhash{$version.':keys'});
}
}
# ----------------------------- returnhash now has all stores for this resource
# ---------------------------- initialize coursedata and userdata for this user
undef %courseopt;
undef %useropt;
my $userprefix=$uname.'_'.$udom.'_';
unless ($uhome eq 'no_host') {
# -------------------------------------------------------------- Get coursedata
unless
((time-$courserdatas{$cid.'.last_cache'})<240) {
my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
':resourcedata',$chome);
if ($reply!~/^error\:/) {
$courserdatas{$cid}=$reply;
$courserdatas{$cid.'.last_cache'}=time;
}
}
map {
my ($name,$value)=split(/\=/,$_);
$courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
} split(/\&/,$courserdatas{$cid});
# --------------------------------------------------- Get userdata (if present)
unless
((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
my $reply=
&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
if ($reply!~/^error\:/) {
$userrdatas{$uname.'___'.$udom}=$reply;
$userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
}
}
map {
my ($name,$value)=split(/\=/,$_);
$useropt{$userprefix.&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
} split(/\&/,$userrdatas{$uname.'___'.$udom});
}
# ----------------- now courseopt, useropt initialized for this user and course
# (used by parmval)
#
# Load keys for this assessment only
#
my %thisassess=();
my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);
map {
$thisassess{$_}=1;
} split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
#
# Load parameters
#
my %c=();
if (tie(%parmhash,'GDBM_File',
&getcfn($safeeval).'_parms.db',&GDBM_READER,0640)) {
my %f=&getformulas($safeeval);
map {
if ($_=~/^A/) {
unless ($f{$_}=~/^\!/) {
if ($f{$_}=~/^parameter/) {
if ($thisassess{$f{$_}}) {
my $val=&parmval($f{$_},$safeeval);
$c{$_}=$val;
$c{$f{$_}}=$val;
}
} else {
my $key=$f{$_};
my $ckey=$key;
$key=~s/^stores\_/resource\./;
$key=~s/\_/\./;
$c{$_}=$returnhash{$key};
$c{$ckey}=$returnhash{$key};
}
}
}
} keys %f;
untie(%parmhash);
}
&setconstants($safeeval,%c);
}
# --------------------------------------------------------- Various form fields
sub textfield {
my ($title,$name,$value)=@_;
return "\n<p><b>$title:</b><br>".
'<input type=text name="'.$name.'" size=80 value="'.$value.'">';
}
sub hiddenfield {
my ($name,$value)=@_;
return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
}
sub selectbox {
my ($title,$name,$value,%options)=@_;
my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
map {
$selout.='<option value="'.$_.'"';
if ($_ eq $value) { $selout.=' selected'; }
$selout.='>'.$options{$_}.'</option>';
} sort keys %options;
return $selout.'</select>';
}
# =============================================== Update information in a sheet
#
# Add new users or assessments, etc.
#
sub updatesheet {
my $safeeval=shift;
my $stype=&gettype($safeeval);
if ($stype eq 'classcalc') {
return &updateclasssheet($safeeval);
} else {
return &updatestudentassesssheet($safeeval);
}
}
# =================================================== Load the rows for a sheet
#
# Import the data for rows
#
sub loadrows {
my ($safeeval,$r)=@_;
my $stype=&gettype($safeeval);
if ($stype eq 'classcalc') {
&loadcourse($safeeval,$r);
} elsif ($stype eq 'studentcalc') {
&loadstudent($safeeval);
} else {
&loadassessment($safeeval);
}
}
# ======================================================= Forced recalculation?
sub checkthis {
my ($keyname,$time)=@_;
return ($time<$expiredates{$keyname});
}
sub forcedrecalc {
my ($uname,$udom,$stype,$usymb)=@_;
my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
my $time=$oldsheets{$key.'.time'};
if ($ENV{'form.forcerecalc'}) { return 1; }
unless ($time) { return 1; }
if ($stype eq 'assesscalc') {
my $map=(split(/\_\_\_/,$usymb))[0];
if (&checkthis('::assesscalc:',$time) ||
&checkthis('::assesscalc:'.$map,$time) ||
&checkthis('::assesscalc:'.$usymb,$time) ||
&checkthis($uname.':'.$udom.':assesscalc:',$time) ||
&checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) ||
&checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) {
return 1;
}
} else {
if (&checkthis('::studentcalc:',$time) ||
&checkthis($uname.':'.$udom.':studentcalc:',$time)) {
return 1;
}
}
return 0;
}
# ============================================================== Export handler
#
# Non-interactive call from with program
#
sub exportsheet {
my ($uname,$udom,$stype,$usymb,$fn)=@_;
my @exportarr=();
#
# Check if cached
#
my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
my $found='';
if ($oldsheets{$key}) {
map {
my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
if ($name eq $fn) {
$found=$value;
}
} split(/\_\_\_\&\_\_\_/,$oldsheets{$key});
}
unless ($found) {
&cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));
if ($oldsheets{$key}) {
map {
my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
if ($name eq $fn) {
$found=$value;
}
} split(/\_\_\_\&\_\_\_/,$oldsheets{$key});
}
}
#
# 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\:/) {
map {
my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
$currentlystored{$name}=$value;
} split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current));
}
$currentlystored{$fn}=join('___;___',@exportarr);
my $newstore='';
map {
if ($newstore) { $newstore.='___&___'; }
$newstore.=$_.'___=___'.$currentlystored{$_};
} keys %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));
}
}
return @exportarr;
}
# ============================================================ Expiration Dates
#
# Load previously cached student spreadsheets for this course
#
sub expirationdates {
undef %expiredates;
my $cid=$ENV{'request.course.id'};
my $reply=&Apache::lonnet::reply('dump:'.
$ENV{'course.'.$cid.'.domain'}.':'.
$ENV{'course.'.$cid.'.num'}.
':nohist_expirationdates',
$ENV{'course.'.$cid.'.home'});
unless ($reply=~/^error\:/) {
map {
my ($name,$value)=split(/\=/,$_);
$expiredates{&Apache::lonnet::unescape($name)}
=&Apache::lonnet::unescape($value);
} split(/\&/,$reply);
}
}
# ===================================================== Calculated sheets cache
#
# Load previously cached student spreadsheets for this course
#
sub cachedcsheets {
my $cid=$ENV{'request.course.id'};
my $reply=&Apache::lonnet::reply('dump:'.
$ENV{'course.'.$cid.'.domain'}.':'.
$ENV{'course.'.$cid.'.num'}.
':nohist_calculatedsheets',
$ENV{'course.'.$cid.'.home'});
unless ($reply=~/^error\:/) {
map {
my ($name,$value)=split(/\=/,$_);
$oldsheets{&Apache::lonnet::unescape($name)}
=&Apache::lonnet::unescape($value);
} split(/\&/,$reply);
}
}
# ===================================================== Calculated sheets cache
#
# Load previously cached assessment spreadsheets for this student
#
sub cachedssheets {
my ($sname,$sdom,$shome)=@_;
unless (($loadedcaches{$sname.'_'.$sdom}) || ($shome eq 'no_host')) {
my $cid=$ENV{'request.course.id'};
my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.
':nohist_calculatedsheets_'.
$ENV{'request.course.id'},
$shome);
unless ($reply=~/^error\:/) {
map {
my ($name,$value)=split(/\=/,$_);
$oldsheets{&Apache::lonnet::unescape($name)}
=&Apache::lonnet::unescape($value);
} split(/\&/,$reply);
}
$loadedcaches{$sname.'_'.$sdom}=1;
}
}
# ===================================================== Calculated sheets cache
#
# Load previously cached assessment spreadsheets for this student
#
# ================================================================ Main handler
#
# Interactive call to screen
#
#
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
map {
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;
}
}
} (split(/&/,$ENV{'QUERY_STRING'}));
# -------------------------------------- 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('<html><head><title>LON-CAPA Spreadsheet</title>');
$r->print(<<ENDSCRIPT);
<script language="JavaScript">
function celledit(cn,cf) {
var cnf=prompt(cn,cf);
if (cnf!=null) {
document.sheet.unewfield.value=cn;
document.sheet.unewformula.value=cnf;
document.sheet.submit();
}
}
function changesheet(cn) {
document.sheet.unewfield.value=cn;
document.sheet.unewformula.value='changesheet';
document.sheet.submit();
}
</script>
ENDSCRIPT
$r->print('</head><body bgcolor="#FFFFFF">'.
'<img align=right src=/adm/lonIcons/lonlogos.gif>'.
'<h1>LON-CAPA Spreadsheet</h1>'.
'<form action="'.$r->uri.'" name=sheet method=post>'.
&hiddenfield('uname',$ENV{'form.uname'}).
&hiddenfield('udom',$ENV{'form.udom'}).
&hiddenfield('usymb',$ENV{'form.usymb'}).
&hiddenfield('unewfield','').
&hiddenfield('unewformula',''));
# ---------------------- Make sure that this gets out, even if user hits "stop"
$r->rflush();
# ---------------------------------------------------------------- Full recalc?
if ($ENV{'form.forcerecalc'}) {
$r->print('<h4>Completely Recalculating Sheet ...</h4>');
undef %spreadsheets;
undef %courserdatas;
undef %userrdatas;
undef %defaultsheets;
undef %updatedata;
}
# ---------------------------------------- Read new sheet or modified worksheet
$r->uri=~/\/(\w+)$/;
my $asheet=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'});
# ------------------------ If a new formula had been entered, go from work copy
if ($ENV{'form.unewfield'}) {
$r->print('<h2>Modified Workcopy</h2>');
$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 {
$r->print('<br><b>Section/Group:</b> '.&getcsec($asheet));
}
}
# ---------------------------------------------------------------- Course title
$r->print('<h1>'.
$ENV{'course.'.$ENV{'request.course.id'}.'.description'}.
'</h1><h3>'.localtime().'</h3>');
# ---------------------------------------------------- See if user can see this
if ((&gettype($asheet) eq 'classcalc') ||
(&getuname($asheet) ne $ENV{'user.name'}) ||
(&getudom($asheet) ne $ENV{'user.domain'})) {
unless (&Apache::lonnet::allowed('vgr',&getcid($asheet))) {
$r->print(
'<h1>Access Permission Denied</h1></form></body></html>');
return OK;
}
}
# ---------------------------------------------------------- Additional options
$r->print(
'<input type=submit name=forcerecalc value="Completely Recalculate Sheet"><p>'
);
if (&gettype($asheet) eq 'assesscalc') {
$r->print ('<p><font size=+2><a href="/adm/studentcalc?uname='.
&getuname($asheet).
'&udom='.&getudom($asheet).
'">Level up: Student Sheet</a></font><p>');
}
if ((&gettype($asheet) eq 'studentcalc') &&
(&Apache::lonnet::allowed('vgr',&getcid($asheet)))) {
$r->print (
'<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/\_[^\_]+$//;
if ($fname eq 'default') { $fname='course_default'; }
$r->print('<input type=submit name=saveas value="Save as ...">'.
'<input type=text size=20 name=newfn value="'.$fname.
'"> (make default: <input type=checkbox name="makedefufn">)<p>');
}
$r->print(&hiddenfield('ufn',&getfilename($asheet)));
# ----------------------------------------------------------------- Load dialog
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
$r->print('<p><input type=submit name=load value="Load ...">'.
'<select name="loadthissheet">'.
'<option name="default">Default</option>');
map {
$r->print('<option name="'.$_.'"');
if ($ENV{'form.ufn'} eq $_) {
$r->print(' selected');
}
$r->print('>'.$_.'</option>');
} &othersheets($asheet,&gettype($asheet));
$r->print('</select><p>');
if (&gettype($asheet) eq 'studentcalc') {
&setothersheets($asheet,&othersheets($asheet,'assesscalc'));
}
}
# --------------------------------------------------------------- Cached sheets
&expirationdates();
undef %oldsheets;
undef %loadedcaches;
if (&gettype($asheet) eq 'classcalc') {
$r->print("Loading previously calculated student sheets ...<br>\n");
$r->rflush();
&cachedcsheets();
} elsif (&gettype($asheet) eq 'studentcalc') {
$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();
&updatesheet($asheet);
$r->print("Updated rows, loading row data ...<br>\n");
$r->rflush();
&loadrows($asheet,$r);
$r->print("Loaded row data, calculating sheet ...<br>\n");
$r->rflush();
my $calcoutput=&calcsheet($asheet);
$r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
# ---------------------------------------------------- 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>');
&tmpwrite($asheet);
if (&gettype($asheet) eq 'studentcalc') {
$r->print('<br>Show rows with empty A column: ');
} else {
$r->print('<br>Show empty rows: ');
}
$r->print('<input type=checkbox name=showall onClick="submit()"');
if ($ENV{'form.showall'}) { $r->print(' checked'); }
$r->print('>');
# ------------------------------------------------------------- Print out sheet
&outsheet($r,$asheet);
$r->print('</form></body></html>');
# ------------------------------------------------------------------------ Done
} else {
# ----------------------------- Not in a course, or not allowed to modify parms
$ENV{'user.error.msg'}=
$r->uri.":opa:0:0:Cannot modify spreadsheet";
return HTTP_NOT_ACCEPTABLE;
}
return OK;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonspreadsheet.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface